/[lmdze]/trunk/Sources/phylmd/clmain.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/clmain.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 40 by guez, Tue Feb 22 13:49:36 2011 UTC revision 51 by guez, Tue Sep 20 09:14:34 2011 UTC
# Line 33  contains Line 33  contains
33      ! en leur ajoutant une dimension, c'est-à-dire "nbsrf" (nombre de      ! en leur ajoutant une dimension, c'est-à-dire "nbsrf" (nombre de
34      ! sous-surfaces).      ! sous-surfaces).
35    
36        use calendar, ONLY : ymds2ju
37        use clqh_m, only: clqh
38        use coefkz_m, only: coefkz
39        use coefkzmin_m, only: coefkzmin
40        USE conf_phys_m, ONLY : iflag_pbl
41        USE dimens_m, ONLY : iim, jjm
42        USE dimphy, ONLY : klev, klon, zmasq
43        USE dimsoil, ONLY : nsoilmx
44        USE dynetat0_m, ONLY : day_ini
45        USE gath_cpl, ONLY : gath2cpl
46        use hbtm_m, only: hbtm
47        USE histcom, ONLY : histbeg_totreg, histdef, histend, histsync
48        use histwrite_m, only: histwrite
49        USE indicesol, ONLY : epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf
50        USE iniprint, ONLY : prt_level
51        USE suphec_m, ONLY : rd, rg, rkappa
52        USE temps, ONLY : annee_ref, itau_phy
53        use yamada4_m, only: yamada4
54    
55      ! Arguments:      ! Arguments:
56      ! dtime----input-R- interval du temps (secondes)  
57      ! itap-----input-I- numero du pas de temps      REAL, INTENT (IN) :: dtime ! interval du temps (secondes)
58        REAL date0
59      ! date0----input-R- jour initial      ! date0----input-R- jour initial
60        INTEGER, INTENT (IN) :: itap
61        ! itap-----input-I- numero du pas de temps
62        REAL, INTENT(IN):: t(klon, klev), q(klon, klev)
63      ! t--------input-R- temperature (K)      ! t--------input-R- temperature (K)
64      ! q--------input-R- vapeur d'eau (kg/kg)      ! q--------input-R- vapeur d'eau (kg/kg)
65        REAL, INTENT (IN):: u(klon, klev), v(klon, klev)
66      ! u--------input-R- vitesse u      ! u--------input-R- vitesse u
67      ! v--------input-R- vitesse v      ! v--------input-R- vitesse v
68      ! ts-------input-R- temperature du sol (en Kelvin)      REAL, INTENT (IN):: paprs(klon, klev+1)
69      ! paprs----input-R- pression a intercouche (Pa)      ! paprs----input-R- pression a intercouche (Pa)
70        REAL, INTENT (IN):: pplay(klon, klev)
71      ! pplay----input-R- pression au milieu de couche (Pa)      ! pplay----input-R- pression au milieu de couche (Pa)
72      ! radsol---input-R- flux radiatif net (positif vers le sol) en W/m**2      REAL, INTENT (IN):: rlon(klon), rlat(klon)
73      ! rlat-----input-R- latitude en degree      ! rlat-----input-R- latitude en degree
74      ! rugos----input-R- longeur de rugosite (en m)      REAL cufi(klon), cvfi(klon)
75      ! cufi-----input-R- resolution des mailles en x (m)      ! cufi-----input-R- resolution des mailles en x (m)
76      ! cvfi-----input-R- resolution des mailles en y (m)      ! cvfi-----input-R- resolution des mailles en y (m)
77        REAL d_t(klon, klev), d_q(klon, klev)
78      ! d_t------output-R- le changement pour "t"      ! d_t------output-R- le changement pour "t"
79      ! d_q------output-R- le changement pour "q"      ! d_q------output-R- le changement pour "q"
80        REAL d_u(klon, klev), d_v(klon, klev)
81      ! d_u------output-R- le changement pour "u"      ! d_u------output-R- le changement pour "u"
82      ! d_v------output-R- le changement pour "v"      ! d_v------output-R- le changement pour "v"
83      ! d_ts-----output-R- le changement pour "ts"      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)
84      ! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)      ! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2)
85      !                    (orientation positive vers le bas)      !                    (orientation positive vers le bas)
86      ! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)      ! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s)
87      ! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal      REAL dflux_t(klon), dflux_q(klon)
     ! flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal  
88      ! dflux_t derive du flux sensible      ! dflux_t derive du flux sensible
89      ! dflux_q derive du flux latent      ! dflux_q derive du flux latent
90      !IM "slab" ocean      !IM "slab" ocean
91        REAL flux_o(klon), flux_g(klon)
92        !IM "slab" ocean
93      ! flux_g---output-R-  flux glace (pour OCEAN='slab  ')      ! flux_g---output-R-  flux glace (pour OCEAN='slab  ')
94      ! flux_o---output-R-  flux ocean (pour OCEAN='slab  ')      ! flux_o---output-R-  flux ocean (pour OCEAN='slab  ')
95        REAL y_flux_o(klon), y_flux_g(klon)
96        REAL tslab(klon), ytslab(klon)
97      ! tslab-in/output-R temperature du slab ocean (en Kelvin)      ! tslab-in/output-R temperature du slab ocean (en Kelvin)
98      ! uniqmnt pour slab      ! uniqmnt pour slab
99        REAL seaice(klon), y_seaice(klon)
100      ! seaice---output-R-  glace de mer (kg/m2) (pour OCEAN='slab  ')      ! seaice---output-R-  glace de mer (kg/m2) (pour OCEAN='slab  ')
101      !cc      REAL y_fqcalving(klon), y_ffonte(klon)
102        REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)
103      ! ffonte----Flux thermique utilise pour fondre la neige      ! ffonte----Flux thermique utilise pour fondre la neige
104      ! fqcalving-Flux d'eau "perdue" par la surface et necessaire pour limiter la      ! fqcalving-Flux d'eau "perdue" par la surface et necessaire pour limiter la
105      !           hauteur de neige, en kg/m2/s      !           hauteur de neige, en kg/m2/s
     ! on rajoute en output yu1 et yv1 qui sont les vents dans  
     ! la premiere couche  
     ! ces 4 variables sont maintenant traites dans phytrac  
     ! itr--------input-I- nombre de traceurs  
     ! tr---------input-R- q. de traceurs  
     ! flux_surf--input-R- flux de traceurs a la surface  
     ! d_tr-------output-R tendance de traceurs  
     !IM cf. AM : PBL  
     ! trmb1-------deep_cape  
     ! trmb2--------inhibition  
     ! trmb3-------Point Omega  
     ! Cape(klon)-------Cape du thermique  
     ! EauLiq(klon)-------Eau liqu integr du thermique  
     ! ctei(klon)-------Critere d'instab d'entrainmt des nuages de CL  
     ! lcl------- Niveau de condensation  
     ! pblh------- HCL  
     ! pblT------- T au nveau HCL  
   
     USE histcom, ONLY : histbeg_totreg, histdef, histend, histsync  
     use histwrite_m, only: histwrite  
     use calendar, ONLY : ymds2ju  
     USE dimens_m, ONLY : iim, jjm  
     USE indicesol, ONLY : epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf  
     USE dimphy, ONLY : klev, klon, zmasq  
     USE dimsoil, ONLY : nsoilmx  
     USE temps, ONLY : annee_ref, itau_phy  
     USE dynetat0_m, ONLY : day_ini  
     USE iniprint, ONLY : prt_level  
     USE suphec_m, ONLY : rd, rg, rkappa  
     USE conf_phys_m, ONLY : iflag_pbl  
     USE gath_cpl, ONLY : gath2cpl  
     use hbtm_m, only: hbtm  
   
     REAL, INTENT (IN) :: dtime  
     REAL date0  
     INTEGER, INTENT (IN) :: itap  
     REAL t(klon, klev), q(klon, klev)  
     REAL u(klon, klev), v(klon, klev)  
     REAL, INTENT (IN) :: paprs(klon, klev+1)  
     REAL, INTENT (IN) :: pplay(klon, klev)  
     REAL, INTENT (IN) :: rlon(klon), rlat(klon)  
     REAL cufi(klon), cvfi(klon)  
     REAL d_t(klon, klev), d_q(klon, klev)  
     REAL d_u(klon, klev), d_v(klon, klev)  
     REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)  
     REAL dflux_t(klon), dflux_q(klon)  
     !IM "slab" ocean  
     REAL flux_o(klon), flux_g(klon)  
     REAL y_flux_o(klon), y_flux_g(klon)  
     REAL tslab(klon), ytslab(klon)  
     REAL seaice(klon), y_seaice(klon)  
     REAL y_fqcalving(klon), y_ffonte(klon)  
     REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)  
106      REAL run_off_lic_0(klon), y_run_off_lic_0(klon)      REAL run_off_lic_0(klon), y_run_off_lic_0(klon)
107    
108      REAL flux_u(klon, klev, nbsrf), flux_v(klon, klev, nbsrf)      REAL flux_u(klon, klev, nbsrf), flux_v(klon, klev, nbsrf)
109        ! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal
110        ! flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal
111      REAL rugmer(klon), agesno(klon, nbsrf)      REAL rugmer(klon), agesno(klon, nbsrf)
112      REAL, INTENT (IN) :: rugoro(klon)      REAL, INTENT (IN) :: rugoro(klon)
113      REAL cdragh(klon), cdragm(klon)      REAL cdragh(klon), cdragm(klon)
# Line 146  contains Line 124  contains
124    
125      REAL pctsrf(klon, nbsrf)      REAL pctsrf(klon, nbsrf)
126      REAL ts(klon, nbsrf)      REAL ts(klon, nbsrf)
127        ! ts-------input-R- temperature du sol (en Kelvin)
128      REAL d_ts(klon, nbsrf)      REAL d_ts(klon, nbsrf)
129        ! d_ts-----output-R- le changement pour "ts"
130      REAL snow(klon, nbsrf)      REAL snow(klon, nbsrf)
131      REAL qsurf(klon, nbsrf)      REAL qsurf(klon, nbsrf)
132      REAL evap(klon, nbsrf)      REAL evap(klon, nbsrf)
# Line 160  contains Line 140  contains
140    
141      REAL sollw(klon, nbsrf), solsw(klon, nbsrf), sollwdown(klon)      REAL sollw(klon, nbsrf), solsw(klon, nbsrf), sollwdown(klon)
142      REAL rugos(klon, nbsrf)      REAL rugos(klon, nbsrf)
143        ! rugos----input-R- longeur de rugosite (en m)
144      ! la nouvelle repartition des surfaces sortie de l'interface      ! la nouvelle repartition des surfaces sortie de l'interface
145      REAL pctsrf_new(klon, nbsrf)      REAL pctsrf_new(klon, nbsrf)
146    
# Line 179  contains Line 160  contains
160      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
161      REAL qsol(klon)      REAL qsol(klon)
162    
163      EXTERNAL clqh, clvent, coefkz, calbeta, cltrac      EXTERNAL clvent, calbeta, cltrac
164    
165      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
166      REAL yalb(klon)      REAL yalb(klon)
167      REAL yalblw(klon)      REAL yalblw(klon)
168      REAL yu1(klon), yv1(klon)      REAL yu1(klon), yv1(klon)
169        ! on rajoute en output yu1 et yv1 qui sont les vents dans
170        ! la premiere couche
171      REAL ysnow(klon), yqsurf(klon), yagesno(klon), yqsol(klon)      REAL ysnow(klon), yqsurf(klon), yagesno(klon), yqsol(klon)
172      REAL yrain_f(klon), ysnow_f(klon)      REAL yrain_f(klon), ysnow_f(klon)
173      REAL ysollw(klon), ysolsw(klon), ysollwdown(klon)      REAL ysollw(klon), ysolsw(klon), ysollwdown(klon)
# Line 208  contains Line 191  contains
191      PARAMETER (ok_nonloc=.FALSE.)      PARAMETER (ok_nonloc=.FALSE.)
192      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)
193    
     !IM 081204 hcl_Anne ? BEG  
194      REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev)      REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev)
195      REAL ykmm(klon, klev+1), ykmn(klon, klev+1)      REAL ykmm(klon, klev+1), ykmn(klon, klev+1)
196      REAL ykmq(klon, klev+1)      REAL ykmq(klon, klev+1)
197      REAL yq2(klon, klev+1), q2(klon, klev+1, nbsrf)      REAL yq2(klon, klev+1), q2(klon, klev+1, nbsrf)
198      REAL q2diag(klon, klev+1)      REAL q2diag(klon, klev+1)
     !IM 081204 hcl_Anne ? END  
199    
200      REAL u1lay(klon), v1lay(klon)      REAL u1lay(klon), v1lay(klon)
201      REAL delp(klon, klev)      REAL delp(klon, klev)
# Line 260  contains Line 241  contains
241      !IM cf. AM : pbl, hbtm (Comme les autres diagnostics on cumule ds      !IM cf. AM : pbl, hbtm (Comme les autres diagnostics on cumule ds
242      ! physiq ce qui permet de sortir les grdeurs par sous surface)      ! physiq ce qui permet de sortir les grdeurs par sous surface)
243      REAL pblh(klon, nbsrf)      REAL pblh(klon, nbsrf)
244        ! pblh------- HCL
245      REAL plcl(klon, nbsrf)      REAL plcl(klon, nbsrf)
246      REAL capcl(klon, nbsrf)      REAL capcl(klon, nbsrf)
247      REAL oliqcl(klon, nbsrf)      REAL oliqcl(klon, nbsrf)
248      REAL cteicl(klon, nbsrf)      REAL cteicl(klon, nbsrf)
249      REAL pblt(klon, nbsrf)      REAL pblt(klon, nbsrf)
250        ! pblT------- T au nveau HCL
251      REAL therm(klon, nbsrf)      REAL therm(klon, nbsrf)
252      REAL trmb1(klon, nbsrf)      REAL trmb1(klon, nbsrf)
253        ! trmb1-------deep_cape
254      REAL trmb2(klon, nbsrf)      REAL trmb2(klon, nbsrf)
255        ! trmb2--------inhibition
256      REAL trmb3(klon, nbsrf)      REAL trmb3(klon, nbsrf)
257        ! trmb3-------Point Omega
258      REAL ypblh(klon)      REAL ypblh(klon)
259      REAL ylcl(klon)      REAL ylcl(klon)
260      REAL ycapcl(klon)      REAL ycapcl(klon)
# Line 411  contains Line 397  contains
397      pctsrf_pot(:, is_oce) = 1. - zmasq      pctsrf_pot(:, is_oce) = 1. - zmasq
398      pctsrf_pot(:, is_sic) = 1. - zmasq      pctsrf_pot(:, is_sic) = 1. - zmasq
399    
400      DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
401         ! chercher les indices:         ! Chercher les indices :
402         ni = 0         ni = 0
403         knon = 0         knon = 0
404         DO i = 1, klon         DO i = 1, klon
# Line 436  contains Line 422  contains
422            CALL histwrite(nidbg, cl_surf(nsrf), itap, debugtab)            CALL histwrite(nidbg, cl_surf(nsrf), itap, debugtab)
423         END IF         END IF
424    
425         IF (knon==0) CYCLE         IF (knon == 0) CYCLE
426    
427         DO j = 1, knon         DO j = 1, knon
428            i = ni(j)            i = ni(j)
# Line 468  contains Line 454  contains
454            ywindsp(j) = sqrt(yu10mx(j)*yu10mx(j)+yu10my(j)*yu10my(j))            ywindsp(j) = sqrt(yu10mx(j)*yu10mx(j)+yu10my(j)*yu10my(j))
455         END DO         END DO
456    
457         !     IF bucket model for continent, copy soil water content         ! IF bucket model for continent, copy soil water content
458         IF (nsrf==is_ter .AND. .NOT. ok_veget) THEN         IF (nsrf == is_ter .AND. .NOT. ok_veget) THEN
459            DO j = 1, knon            DO j = 1, knon
460               i = ni(j)               i = ni(j)
461               yqsol(j) = qsol(i)               yqsol(j) = qsol(i)
# Line 500  contains Line 486  contains
486         ! calculer Cdrag et les coefficients d'echange         ! calculer Cdrag et les coefficients d'echange
487         CALL coefkz(nsrf, knon, ypaprs, ypplay, ksta, ksta_ter, yts,&         CALL coefkz(nsrf, knon, ypaprs, ypplay, ksta, ksta_ter, yts,&
488              yrugos, yu, yv, yt, yq, yqsurf, ycoefm, ycoefh)              yrugos, yu, yv, yt, yq, yqsurf, ycoefm, ycoefh)
489         !IM 081204 BEG         IF (iflag_pbl == 1) THEN
        !CR test  
        IF (iflag_pbl==1) THEN  
           !IM 081204 END  
490            CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)            CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)
491            DO k = 1, klev            DO k = 1, klev
492               DO i = 1, knon               DO i = 1, knon
# Line 513  contains Line 496  contains
496            END DO            END DO
497         END IF         END IF
498    
499         !IM cf JLD : on seuille ycoefm et ycoefh         ! on seuille ycoefm et ycoefh
500         IF (nsrf==is_oce) THEN         IF (nsrf == is_oce) THEN
501            DO j = 1, knon            DO j = 1, knon
              !           ycoefm(j, 1)=min(ycoefm(j, 1), 1.1E-3)  
502               ycoefm(j, 1) = min(ycoefm(j, 1), cdmmax)               ycoefm(j, 1) = min(ycoefm(j, 1), cdmmax)
              !           ycoefh(j, 1)=min(ycoefh(j, 1), 1.1E-3)  
503               ycoefh(j, 1) = min(ycoefh(j, 1), cdhmax)               ycoefh(j, 1) = min(ycoefh(j, 1), cdhmax)
504            END DO            END DO
505         END IF         END IF
506    
        !IM: 261103  
507         IF (ok_kzmin) THEN         IF (ok_kzmin) THEN
508            !IM cf FH: 201103 BEG            ! Calcul d'une diffusion minimale pour les conditions tres stables
509            !   Calcul d'une diffusion minimale pour les conditions tres stables.            CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, ycoefm(:, 1), &
           CALL coefkzmin(knon, ypaprs, ypplay, yu, yv, yt, yq, ycoefm, &  
510                 ycoefm0, ycoefh0)                 ycoefm0, ycoefh0)
511    
512            IF (1==1) THEN            DO k = 1, klev
513               DO k = 1, klev               DO i = 1, knon
514                  DO i = 1, knon                  ycoefm(i, k) = max(ycoefm(i, k), ycoefm0(i, k))
515                     ycoefm(i, k) = max(ycoefm(i, k), ycoefm0(i, k))                  ycoefh(i, k) = max(ycoefh(i, k), ycoefh0(i, k))
                    ycoefh(i, k) = max(ycoefh(i, k), ycoefh0(i, k))  
                 END DO  
516               END DO               END DO
517            END IF            END DO
518            !IM cf FH: 201103 END         END IF
           !IM: 261103  
        END IF !ok_kzmin  
519    
520         IF (iflag_pbl>=3) THEN         IF (iflag_pbl >= 3) THEN
521            ! MELLOR ET YAMADA adapté à Mars, Richard Fournier et Frédéric Hourdin            ! MELLOR ET YAMADA adapté à Mars, Richard Fournier et Frédéric Hourdin
522            yzlay(1:knon, 1) = rd*yt(1:knon, 1)/(0.5*(ypaprs(1:knon, &            yzlay(1:knon, 1) = rd*yt(1:knon, 1)/(0.5*(ypaprs(1:knon, &
523                 1)+ypplay(1:knon, 1)))*(ypaprs(1:knon, 1)-ypplay(1:knon, 1))/rg                 1)+ypplay(1:knon, 1)))*(ypaprs(1:knon, 1)-ypplay(1:knon, 1))/rg
# Line 568  contains Line 543  contains
543               END DO               END DO
544            END DO            END DO
545    
546            !   Bug introduit volontairement pour converger avec les resultats            y_cd_m(1:knon) = ycoefm(1:knon, 1)
547            !  du papier sur les thermiques.            y_cd_h(1:knon) = ycoefh(1:knon, 1)
           IF (1==1) THEN  
              y_cd_m(1:knon) = ycoefm(1:knon, 1)  
              y_cd_h(1:knon) = ycoefh(1:knon, 1)  
           ELSE  
              y_cd_h(1:knon) = ycoefm(1:knon, 1)  
              y_cd_m(1:knon) = ycoefh(1:knon, 1)  
           END IF  
548            CALL ustarhb(knon, yu, yv, y_cd_m, yustar)            CALL ustarhb(knon, yu, yv, y_cd_m, yustar)
549    
550            IF (prt_level>9) THEN            IF (prt_level>9) THEN
551               PRINT *, 'USTAR = ', yustar               PRINT *, 'USTAR = ', yustar
552            END IF            END IF
553    
554            !   iflag_pbl peut etre utilise comme longuer de melange            ! iflag_pbl peut être utilisé comme longueur de mélange
555    
556            IF (iflag_pbl>=11) THEN            IF (iflag_pbl >= 11) THEN
557               CALL vdif_kcay(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, &               CALL vdif_kcay(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, &
558                    yu, yv, yteta, y_cd_m, yq2, q2diag, ykmm, ykmn, yustar, &                    yu, yv, yteta, y_cd_m, yq2, q2diag, ykmm, ykmn, yustar, &
559                    iflag_pbl)                    iflag_pbl)
560            ELSE            ELSE
561               CALL yamada4(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, yu, &               CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &
562                    yv, yteta, y_cd_m, yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)                    y_cd_m, yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)
563            END IF            END IF
564    
565            ycoefm(1:knon, 1) = y_cd_m(1:knon)            ycoefm(1:knon, 1) = y_cd_m(1:knon)
# Line 624  contains Line 592  contains
592    
593         ! calculer la longueur de rugosite sur ocean         ! calculer la longueur de rugosite sur ocean
594         yrugm = 0.         yrugm = 0.
595         IF (nsrf==is_oce) THEN         IF (nsrf == is_oce) THEN
596            DO j = 1, knon            DO j = 1, knon
597               yrugm(j) = 0.018*ycoefm(j, 1)*(yu1(j)**2+yv1(j)**2)/rg + &               yrugm(j) = 0.018*ycoefm(j, 1)*(yu1(j)**2+yv1(j)**2)/rg + &
598                    0.11*14E-6/sqrt(ycoefm(j, 1)*(yu1(j)**2+yv1(j)**2))                    0.11*14E-6/sqrt(ycoefm(j, 1)*(yu1(j)**2+yv1(j)**2))
# Line 645  contains Line 613  contains
613               ycoefm(j, k) = ycoefm(j, k)*ypct(j)               ycoefm(j, k) = ycoefm(j, k)*ypct(j)
614               y_d_t(j, k) = y_d_t(j, k)*ypct(j)               y_d_t(j, k) = y_d_t(j, k)*ypct(j)
615               y_d_q(j, k) = y_d_q(j, k)*ypct(j)               y_d_q(j, k) = y_d_q(j, k)*ypct(j)
              !§§§ PB  
616               flux_t(i, k, nsrf) = y_flux_t(j, k)               flux_t(i, k, nsrf) = y_flux_t(j, k)
617               flux_q(i, k, nsrf) = y_flux_q(j, k)               flux_q(i, k, nsrf) = y_flux_q(j, k)
618               flux_u(i, k, nsrf) = y_flux_u(j, k)               flux_u(i, k, nsrf) = y_flux_u(j, k)
619               flux_v(i, k, nsrf) = y_flux_v(j, k)               flux_v(i, k, nsrf) = y_flux_v(j, k)
              !$$$ PB        y_flux_t(j, k) = y_flux_t(j, k) * ypct(j)  
              !$$$ PB        y_flux_q(j, k) = y_flux_q(j, k) * ypct(j)  
620               y_d_u(j, k) = y_d_u(j, k)*ypct(j)               y_d_u(j, k) = y_d_u(j, k)*ypct(j)
621               y_d_v(j, k) = y_d_v(j, k)*ypct(j)               y_d_v(j, k) = y_d_v(j, k)*ypct(j)
              !$$$ PB        y_flux_u(j, k) = y_flux_u(j, k) * ypct(j)  
              !$$$ PB        y_flux_v(j, k) = y_flux_v(j, k) * ypct(j)  
622            END DO            END DO
623         END DO         END DO
624    
# Line 676  contains Line 639  contains
639            qsurf(i, nsrf) = yqsurf(j)            qsurf(i, nsrf) = yqsurf(j)
640            rugos(i, nsrf) = yz0_new(j)            rugos(i, nsrf) = yz0_new(j)
641            fluxlat(i, nsrf) = yfluxlat(j)            fluxlat(i, nsrf) = yfluxlat(j)
642            !$$$ pb         rugmer(i) = yrugm(j)            IF (nsrf == is_oce) THEN
           IF (nsrf==is_oce) THEN  
643               rugmer(i) = yrugm(j)               rugmer(i) = yrugm(j)
644               rugos(i, nsrf) = yrugm(j)               rugos(i, nsrf) = yrugm(j)
645            END IF            END IF
           !IM cf JLD ??  
646            agesno(i, nsrf) = yagesno(j)            agesno(i, nsrf) = yagesno(j)
647            fqcalving(i, nsrf) = y_fqcalving(j)            fqcalving(i, nsrf) = y_fqcalving(j)
648            ffonte(i, nsrf) = y_ffonte(j)            ffonte(i, nsrf) = y_ffonte(j)
# Line 692  contains Line 653  contains
653            zu1(i) = zu1(i) + yu1(j)            zu1(i) = zu1(i) + yu1(j)
654            zv1(i) = zv1(i) + yv1(j)            zv1(i) = zv1(i) + yv1(j)
655         END DO         END DO
656         IF (nsrf==is_ter) THEN         IF (nsrf == is_ter) THEN
657            DO j = 1, knon            DO j = 1, knon
658               i = ni(j)               i = ni(j)
659               qsol(i) = yqsol(j)               qsol(i) = yqsol(j)
660            END DO            END DO
661         END IF         END IF
662         IF (nsrf==is_lic) THEN         IF (nsrf == is_lic) THEN
663            DO j = 1, knon            DO j = 1, knon
664               i = ni(j)               i = ni(j)
665               run_off_lic_0(i) = y_run_off_lic_0(j)               run_off_lic_0(i) = y_run_off_lic_0(j)
# Line 718  contains Line 679  contains
679            DO k = 1, klev            DO k = 1, klev
680               d_t(i, k) = d_t(i, k) + y_d_t(j, k)               d_t(i, k) = d_t(i, k) + y_d_t(j, k)
681               d_q(i, k) = d_q(i, k) + y_d_q(j, k)               d_q(i, k) = d_q(i, k) + y_d_q(j, k)
              !$$$ PB        flux_t(i, k) = flux_t(i, k) + y_flux_t(j, k)  
              !$$$         flux_q(i, k) = flux_q(i, k) + y_flux_q(j, k)  
682               d_u(i, k) = d_u(i, k) + y_d_u(j, k)               d_u(i, k) = d_u(i, k) + y_d_u(j, k)
683               d_v(i, k) = d_v(i, k) + y_d_v(j, k)               d_v(i, k) = d_v(i, k) + y_d_v(j, k)
              !$$$  PB       flux_u(i, k) = flux_u(i, k) + y_flux_u(j, k)  
              !$$$         flux_v(i, k) = flux_v(i, k) + y_flux_v(j, k)  
684               zcoefh(i, k) = zcoefh(i, k) + ycoefh(j, k)               zcoefh(i, k) = zcoefh(i, k) + ycoefh(j, k)
685            END DO            END DO
686         END DO         END DO
# Line 740  contains Line 697  contains
697                 1)))*(ypaprs(j, 1)-ypplay(j, 1))                 1)))*(ypaprs(j, 1)-ypplay(j, 1))
698            tairsol(j) = yts(j) + y_d_ts(j)            tairsol(j) = yts(j) + y_d_ts(j)
699            rugo1(j) = yrugos(j)            rugo1(j) = yrugos(j)
700            IF (nsrf==is_oce) THEN            IF (nsrf == is_oce) THEN
701               rugo1(j) = rugos(i, nsrf)               rugo1(j) = rugos(i, nsrf)
702            END IF            END IF
703            psfce(j) = ypaprs(j, 1)            psfce(j) = ypaprs(j, 1)
# Line 752  contains Line 709  contains
709         CALL stdlevvar(klon, knon, nsrf, zxli, uzon, vmer, tair1, qair1, zgeo1, &         CALL stdlevvar(klon, knon, nsrf, zxli, uzon, vmer, tair1, qair1, zgeo1, &
710              tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, yt10m, yq10m, &              tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, yt10m, yq10m, &
711              yu10m, yustar)              yu10m, yustar)
        !IM 081204 END  
712    
713         DO j = 1, knon         DO j = 1, knon
714            i = ni(j)            i = ni(j)
# Line 794  contains Line 750  contains
750            END DO            END DO
751         END DO         END DO
752         !IM "slab" ocean         !IM "slab" ocean
753         IF (nsrf==is_oce) THEN         IF (nsrf == is_oce) THEN
754            DO j = 1, knon            DO j = 1, knon
755               ! on projette sur la grille globale               ! on projette sur la grille globale
756               i = ni(j)               i = ni(j)
# Line 806  contains Line 762  contains
762            END DO            END DO
763         END IF         END IF
764    
765         IF (nsrf==is_sic) THEN         IF (nsrf == is_sic) THEN
766            DO j = 1, knon            DO j = 1, knon
767               i = ni(j)               i = ni(j)
768               ! On pondère lorsque l'on fait le bilan au sol :               ! On pondère lorsque l'on fait le bilan au sol :
              ! flux_g(i) = y_flux_g(j)*ypct(j)  
769               IF (pctsrf_new(i, is_sic)>epsfra) THEN               IF (pctsrf_new(i, is_sic)>epsfra) THEN
770                  flux_g(i) = y_flux_g(j)                  flux_g(i) = y_flux_g(j)
771               ELSE               ELSE
# Line 819  contains Line 774  contains
774            END DO            END DO
775    
776         END IF         END IF
777         !nsrf.EQ.is_sic                                                     IF (ocean == 'slab  ') THEN
778         IF (ocean=='slab  ') THEN            IF (nsrf == is_oce) THEN
           IF (nsrf==is_oce) THEN  
779               tslab(1:klon) = ytslab(1:klon)               tslab(1:klon) = ytslab(1:klon)
780               seaice(1:klon) = y_seaice(1:klon)               seaice(1:klon) = y_seaice(1:klon)
              !nsrf                                                        
781            END IF            END IF
           !OCEAN                                                        
782         END IF         END IF
783      END DO      END DO loop_surface
784    
785      ! On utilise les nouvelles surfaces      ! On utilise les nouvelles surfaces
     ! A rajouter: conservation de l'albedo  
786    
787      rugos(:, is_oce) = rugmer      rugos(:, is_oce) = rugmer
788      pctsrf = pctsrf_new      pctsrf = pctsrf_new
Legend:
Removed from v.40  
changed lines
  Added in v.51
  ViewVC Help
Powered by ViewVC 1.1.21