/[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 61 by guez, Fri Apr 20 14:58:43 2012 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 histsync_m, ONLY : histsync
48        USE histbeg_totreg_m, ONLY : histbeg_totreg
49        USE histend_m, ONLY : histend
50        USE histdef_m, ONLY : histdef
51        use histwrite_m, only: histwrite
52        USE indicesol, ONLY : epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf
53        USE conf_gcm_m, ONLY : prt_level
54        USE suphec_m, ONLY : rd, rg, rkappa
55        USE temps, ONLY : annee_ref, itau_phy
56        use yamada4_m, only: yamada4
57    
58      ! Arguments:      ! Arguments:
59      ! dtime----input-R- interval du temps (secondes)  
60      ! itap-----input-I- numero du pas de temps      REAL, INTENT (IN) :: dtime ! interval du temps (secondes)
61        REAL date0
62      ! date0----input-R- jour initial      ! date0----input-R- jour initial
63        INTEGER, INTENT (IN) :: itap
64        ! itap-----input-I- numero du pas de temps
65        REAL, INTENT(IN):: t(klon, klev), q(klon, klev)
66      ! t--------input-R- temperature (K)      ! t--------input-R- temperature (K)
67      ! q--------input-R- vapeur d'eau (kg/kg)      ! q--------input-R- vapeur d'eau (kg/kg)
68        REAL, INTENT (IN):: u(klon, klev), v(klon, klev)
69      ! u--------input-R- vitesse u      ! u--------input-R- vitesse u
70      ! v--------input-R- vitesse v      ! v--------input-R- vitesse v
71      ! ts-------input-R- temperature du sol (en Kelvin)      REAL, INTENT (IN):: paprs(klon, klev+1)
72      ! paprs----input-R- pression a intercouche (Pa)      ! paprs----input-R- pression a intercouche (Pa)
73        REAL, INTENT (IN):: pplay(klon, klev)
74      ! pplay----input-R- pression au milieu de couche (Pa)      ! pplay----input-R- pression au milieu de couche (Pa)
75      ! radsol---input-R- flux radiatif net (positif vers le sol) en W/m**2      REAL, INTENT (IN):: rlon(klon), rlat(klon)
76      ! rlat-----input-R- latitude en degree      ! rlat-----input-R- latitude en degree
77      ! rugos----input-R- longeur de rugosite (en m)      REAL cufi(klon), cvfi(klon)
78      ! cufi-----input-R- resolution des mailles en x (m)      ! cufi-----input-R- resolution des mailles en x (m)
79      ! cvfi-----input-R- resolution des mailles en y (m)      ! cvfi-----input-R- resolution des mailles en y (m)
80        REAL d_t(klon, klev), d_q(klon, klev)
81      ! d_t------output-R- le changement pour "t"      ! d_t------output-R- le changement pour "t"
82      ! d_q------output-R- le changement pour "q"      ! d_q------output-R- le changement pour "q"
83        REAL d_u(klon, klev), d_v(klon, klev)
84      ! d_u------output-R- le changement pour "u"      ! d_u------output-R- le changement pour "u"
85      ! d_v------output-R- le changement pour "v"      ! d_v------output-R- le changement pour "v"
86      ! d_ts-----output-R- le changement pour "ts"      REAL flux_t(klon, klev, nbsrf), flux_q(klon, klev, nbsrf)
87      ! 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)
88      !                    (orientation positive vers le bas)      !                    (orientation positive vers le bas)
89      ! 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)
90      ! 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  
91      ! dflux_t derive du flux sensible      ! dflux_t derive du flux sensible
92      ! dflux_q derive du flux latent      ! dflux_q derive du flux latent
93      !IM "slab" ocean      !IM "slab" ocean
94        REAL flux_o(klon), flux_g(klon)
95        !IM "slab" ocean
96      ! flux_g---output-R-  flux glace (pour OCEAN='slab  ')      ! flux_g---output-R-  flux glace (pour OCEAN='slab  ')
97      ! flux_o---output-R-  flux ocean (pour OCEAN='slab  ')      ! flux_o---output-R-  flux ocean (pour OCEAN='slab  ')
98        REAL y_flux_o(klon), y_flux_g(klon)
99        REAL tslab(klon), ytslab(klon)
100      ! tslab-in/output-R temperature du slab ocean (en Kelvin)      ! tslab-in/output-R temperature du slab ocean (en Kelvin)
101      ! uniqmnt pour slab      ! uniqmnt pour slab
102        REAL seaice(klon), y_seaice(klon)
103      ! seaice---output-R-  glace de mer (kg/m2) (pour OCEAN='slab  ')      ! seaice---output-R-  glace de mer (kg/m2) (pour OCEAN='slab  ')
104      !cc      REAL y_fqcalving(klon), y_ffonte(klon)
105        REAL fqcalving(klon, nbsrf), ffonte(klon, nbsrf)
106      ! ffonte----Flux thermique utilise pour fondre la neige      ! ffonte----Flux thermique utilise pour fondre la neige
107      ! 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
108      !           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)  
109      REAL run_off_lic_0(klon), y_run_off_lic_0(klon)      REAL run_off_lic_0(klon), y_run_off_lic_0(klon)
110    
111      REAL flux_u(klon, klev, nbsrf), flux_v(klon, klev, nbsrf)      REAL flux_u(klon, klev, nbsrf), flux_v(klon, klev, nbsrf)
112        ! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal
113        ! flux_v---output-R- tension du vent Y: (kg m/s)/(m**2 s) ou Pascal
114      REAL rugmer(klon), agesno(klon, nbsrf)      REAL rugmer(klon), agesno(klon, nbsrf)
115      REAL, INTENT (IN) :: rugoro(klon)      REAL, INTENT (IN) :: rugoro(klon)
116      REAL cdragh(klon), cdragm(klon)      REAL cdragh(klon), cdragm(klon)
# Line 146  contains Line 127  contains
127    
128      REAL pctsrf(klon, nbsrf)      REAL pctsrf(klon, nbsrf)
129      REAL ts(klon, nbsrf)      REAL ts(klon, nbsrf)
130        ! ts-------input-R- temperature du sol (en Kelvin)
131      REAL d_ts(klon, nbsrf)      REAL d_ts(klon, nbsrf)
132        ! d_ts-----output-R- le changement pour "ts"
133      REAL snow(klon, nbsrf)      REAL snow(klon, nbsrf)
134      REAL qsurf(klon, nbsrf)      REAL qsurf(klon, nbsrf)
135      REAL evap(klon, nbsrf)      REAL evap(klon, nbsrf)
# Line 160  contains Line 143  contains
143    
144      REAL sollw(klon, nbsrf), solsw(klon, nbsrf), sollwdown(klon)      REAL sollw(klon, nbsrf), solsw(klon, nbsrf), sollwdown(klon)
145      REAL rugos(klon, nbsrf)      REAL rugos(klon, nbsrf)
146        ! rugos----input-R- longeur de rugosite (en m)
147      ! la nouvelle repartition des surfaces sortie de l'interface      ! la nouvelle repartition des surfaces sortie de l'interface
148      REAL pctsrf_new(klon, nbsrf)      REAL pctsrf_new(klon, nbsrf)
149    
# Line 179  contains Line 163  contains
163      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
164      REAL qsol(klon)      REAL qsol(klon)
165    
166      EXTERNAL clqh, clvent, coefkz, calbeta, cltrac      EXTERNAL clvent, calbeta, cltrac
167    
168      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
169      REAL yalb(klon)      REAL yalb(klon)
170      REAL yalblw(klon)      REAL yalblw(klon)
171      REAL yu1(klon), yv1(klon)      REAL yu1(klon), yv1(klon)
172        ! on rajoute en output yu1 et yv1 qui sont les vents dans
173        ! la premiere couche
174      REAL ysnow(klon), yqsurf(klon), yagesno(klon), yqsol(klon)      REAL ysnow(klon), yqsurf(klon), yagesno(klon), yqsol(klon)
175      REAL yrain_f(klon), ysnow_f(klon)      REAL yrain_f(klon), ysnow_f(klon)
176      REAL ysollw(klon), ysolsw(klon), ysollwdown(klon)      REAL ysollw(klon), ysolsw(klon), ysollwdown(klon)
# Line 208  contains Line 194  contains
194      PARAMETER (ok_nonloc=.FALSE.)      PARAMETER (ok_nonloc=.FALSE.)
195      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)
196    
     !IM 081204 hcl_Anne ? BEG  
197      REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev)      REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev)
198      REAL ykmm(klon, klev+1), ykmn(klon, klev+1)      REAL ykmm(klon, klev+1), ykmn(klon, klev+1)
199      REAL ykmq(klon, klev+1)      REAL ykmq(klon, klev+1)
200      REAL yq2(klon, klev+1), q2(klon, klev+1, nbsrf)      REAL yq2(klon, klev+1), q2(klon, klev+1, nbsrf)
201      REAL q2diag(klon, klev+1)      REAL q2diag(klon, klev+1)
     !IM 081204 hcl_Anne ? END  
202    
203      REAL u1lay(klon), v1lay(klon)      REAL u1lay(klon), v1lay(klon)
204      REAL delp(klon, klev)      REAL delp(klon, klev)
# Line 260  contains Line 244  contains
244      !IM cf. AM : pbl, hbtm (Comme les autres diagnostics on cumule ds      !IM cf. AM : pbl, hbtm (Comme les autres diagnostics on cumule ds
245      ! physiq ce qui permet de sortir les grdeurs par sous surface)      ! physiq ce qui permet de sortir les grdeurs par sous surface)
246      REAL pblh(klon, nbsrf)      REAL pblh(klon, nbsrf)
247        ! pblh------- HCL
248      REAL plcl(klon, nbsrf)      REAL plcl(klon, nbsrf)
249      REAL capcl(klon, nbsrf)      REAL capcl(klon, nbsrf)
250      REAL oliqcl(klon, nbsrf)      REAL oliqcl(klon, nbsrf)
251      REAL cteicl(klon, nbsrf)      REAL cteicl(klon, nbsrf)
252      REAL pblt(klon, nbsrf)      REAL pblt(klon, nbsrf)
253        ! pblT------- T au nveau HCL
254      REAL therm(klon, nbsrf)      REAL therm(klon, nbsrf)
255      REAL trmb1(klon, nbsrf)      REAL trmb1(klon, nbsrf)
256        ! trmb1-------deep_cape
257      REAL trmb2(klon, nbsrf)      REAL trmb2(klon, nbsrf)
258        ! trmb2--------inhibition
259      REAL trmb3(klon, nbsrf)      REAL trmb3(klon, nbsrf)
260        ! trmb3-------Point Omega
261      REAL ypblh(klon)      REAL ypblh(klon)
262      REAL ylcl(klon)      REAL ylcl(klon)
263      REAL ycapcl(klon)      REAL ycapcl(klon)
# Line 411  contains Line 400  contains
400      pctsrf_pot(:, is_oce) = 1. - zmasq      pctsrf_pot(:, is_oce) = 1. - zmasq
401      pctsrf_pot(:, is_sic) = 1. - zmasq      pctsrf_pot(:, is_sic) = 1. - zmasq
402    
403      DO nsrf = 1, nbsrf      loop_surface: DO nsrf = 1, nbsrf
404         ! chercher les indices:         ! Chercher les indices :
405         ni = 0         ni = 0
406         knon = 0         knon = 0
407         DO i = 1, klon         DO i = 1, klon
# Line 436  contains Line 425  contains
425            CALL histwrite(nidbg, cl_surf(nsrf), itap, debugtab)            CALL histwrite(nidbg, cl_surf(nsrf), itap, debugtab)
426         END IF         END IF
427    
428         IF (knon==0) CYCLE         IF (knon == 0) CYCLE
429    
430         DO j = 1, knon         DO j = 1, knon
431            i = ni(j)            i = ni(j)
# Line 468  contains Line 457  contains
457            ywindsp(j) = sqrt(yu10mx(j)*yu10mx(j)+yu10my(j)*yu10my(j))            ywindsp(j) = sqrt(yu10mx(j)*yu10mx(j)+yu10my(j)*yu10my(j))
458         END DO         END DO
459    
460         !     IF bucket model for continent, copy soil water content         ! IF bucket model for continent, copy soil water content
461         IF (nsrf==is_ter .AND. .NOT. ok_veget) THEN         IF (nsrf == is_ter .AND. .NOT. ok_veget) THEN
462            DO j = 1, knon            DO j = 1, knon
463               i = ni(j)               i = ni(j)
464               yqsol(j) = qsol(i)               yqsol(j) = qsol(i)
# Line 500  contains Line 489  contains
489         ! calculer Cdrag et les coefficients d'echange         ! calculer Cdrag et les coefficients d'echange
490         CALL coefkz(nsrf, knon, ypaprs, ypplay, ksta, ksta_ter, yts,&         CALL coefkz(nsrf, knon, ypaprs, ypplay, ksta, ksta_ter, yts,&
491              yrugos, yu, yv, yt, yq, yqsurf, ycoefm, ycoefh)              yrugos, yu, yv, yt, yq, yqsurf, ycoefm, ycoefh)
492         !IM 081204 BEG         IF (iflag_pbl == 1) THEN
        !CR test  
        IF (iflag_pbl==1) THEN  
           !IM 081204 END  
493            CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)            CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)
494            DO k = 1, klev            DO k = 1, klev
495               DO i = 1, knon               DO i = 1, knon
# Line 513  contains Line 499  contains
499            END DO            END DO
500         END IF         END IF
501    
502         !IM cf JLD : on seuille ycoefm et ycoefh         ! on seuille ycoefm et ycoefh
503         IF (nsrf==is_oce) THEN         IF (nsrf == is_oce) THEN
504            DO j = 1, knon            DO j = 1, knon
              !           ycoefm(j, 1)=min(ycoefm(j, 1), 1.1E-3)  
505               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)  
506               ycoefh(j, 1) = min(ycoefh(j, 1), cdhmax)               ycoefh(j, 1) = min(ycoefh(j, 1), cdhmax)
507            END DO            END DO
508         END IF         END IF
509    
        !IM: 261103  
510         IF (ok_kzmin) THEN         IF (ok_kzmin) THEN
511            !IM cf FH: 201103 BEG            ! Calcul d'une diffusion minimale pour les conditions tres stables
512            !   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, &  
513                 ycoefm0, ycoefh0)                 ycoefm0, ycoefh0)
514    
515            IF (1==1) THEN            DO k = 1, klev
516               DO k = 1, klev               DO i = 1, knon
517                  DO i = 1, knon                  ycoefm(i, k) = max(ycoefm(i, k), ycoefm0(i, k))
518                     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  
519               END DO               END DO
520            END IF            END DO
521            !IM cf FH: 201103 END         END IF
           !IM: 261103  
        END IF !ok_kzmin  
522    
523         IF (iflag_pbl>=3) THEN         IF (iflag_pbl >= 3) THEN
524            ! MELLOR ET YAMADA adapté à Mars, Richard Fournier et Frédéric Hourdin            ! MELLOR ET YAMADA adapté à Mars, Richard Fournier et Frédéric Hourdin
525            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, &
526                 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 546  contains
546               END DO               END DO
547            END DO            END DO
548    
549            !   Bug introduit volontairement pour converger avec les resultats            y_cd_m(1:knon) = ycoefm(1:knon, 1)
550            !  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  
551            CALL ustarhb(knon, yu, yv, y_cd_m, yustar)            CALL ustarhb(knon, yu, yv, y_cd_m, yustar)
552    
553            IF (prt_level>9) THEN            IF (prt_level>9) THEN
554               PRINT *, 'USTAR = ', yustar               PRINT *, 'USTAR = ', yustar
555            END IF            END IF
556    
557            !   iflag_pbl peut etre utilise comme longuer de melange            ! iflag_pbl peut être utilisé comme longueur de mélange
558    
559            IF (iflag_pbl>=11) THEN            IF (iflag_pbl >= 11) THEN
560               CALL vdif_kcay(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, &               CALL vdif_kcay(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, &
561                    yu, yv, yteta, y_cd_m, yq2, q2diag, ykmm, ykmn, yustar, &                    yu, yv, yteta, y_cd_m, yq2, q2diag, ykmm, ykmn, yustar, &
562                    iflag_pbl)                    iflag_pbl)
563            ELSE            ELSE
564               CALL yamada4(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, yu, &               CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &
565                    yv, yteta, y_cd_m, yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)                    y_cd_m, yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)
566            END IF            END IF
567    
568            ycoefm(1:knon, 1) = y_cd_m(1:knon)            ycoefm(1:knon, 1) = y_cd_m(1:knon)
# Line 624  contains Line 595  contains
595    
596         ! calculer la longueur de rugosite sur ocean         ! calculer la longueur de rugosite sur ocean
597         yrugm = 0.         yrugm = 0.
598         IF (nsrf==is_oce) THEN         IF (nsrf == is_oce) THEN
599            DO j = 1, knon            DO j = 1, knon
600               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 + &
601                    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 616  contains
616               ycoefm(j, k) = ycoefm(j, k)*ypct(j)               ycoefm(j, k) = ycoefm(j, k)*ypct(j)
617               y_d_t(j, k) = y_d_t(j, k)*ypct(j)               y_d_t(j, k) = y_d_t(j, k)*ypct(j)
618               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  
619               flux_t(i, k, nsrf) = y_flux_t(j, k)               flux_t(i, k, nsrf) = y_flux_t(j, k)
620               flux_q(i, k, nsrf) = y_flux_q(j, k)               flux_q(i, k, nsrf) = y_flux_q(j, k)
621               flux_u(i, k, nsrf) = y_flux_u(j, k)               flux_u(i, k, nsrf) = y_flux_u(j, k)
622               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)  
623               y_d_u(j, k) = y_d_u(j, k)*ypct(j)               y_d_u(j, k) = y_d_u(j, k)*ypct(j)
624               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)  
625            END DO            END DO
626         END DO         END DO
627    
# Line 676  contains Line 642  contains
642            qsurf(i, nsrf) = yqsurf(j)            qsurf(i, nsrf) = yqsurf(j)
643            rugos(i, nsrf) = yz0_new(j)            rugos(i, nsrf) = yz0_new(j)
644            fluxlat(i, nsrf) = yfluxlat(j)            fluxlat(i, nsrf) = yfluxlat(j)
645            !$$$ pb         rugmer(i) = yrugm(j)            IF (nsrf == is_oce) THEN
           IF (nsrf==is_oce) THEN  
646               rugmer(i) = yrugm(j)               rugmer(i) = yrugm(j)
647               rugos(i, nsrf) = yrugm(j)               rugos(i, nsrf) = yrugm(j)
648            END IF            END IF
           !IM cf JLD ??  
649            agesno(i, nsrf) = yagesno(j)            agesno(i, nsrf) = yagesno(j)
650            fqcalving(i, nsrf) = y_fqcalving(j)            fqcalving(i, nsrf) = y_fqcalving(j)
651            ffonte(i, nsrf) = y_ffonte(j)            ffonte(i, nsrf) = y_ffonte(j)
# Line 692  contains Line 656  contains
656            zu1(i) = zu1(i) + yu1(j)            zu1(i) = zu1(i) + yu1(j)
657            zv1(i) = zv1(i) + yv1(j)            zv1(i) = zv1(i) + yv1(j)
658         END DO         END DO
659         IF (nsrf==is_ter) THEN         IF (nsrf == is_ter) THEN
660            DO j = 1, knon            DO j = 1, knon
661               i = ni(j)               i = ni(j)
662               qsol(i) = yqsol(j)               qsol(i) = yqsol(j)
663            END DO            END DO
664         END IF         END IF
665         IF (nsrf==is_lic) THEN         IF (nsrf == is_lic) THEN
666            DO j = 1, knon            DO j = 1, knon
667               i = ni(j)               i = ni(j)
668               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 682  contains
682            DO k = 1, klev            DO k = 1, klev
683               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)
684               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)  
685               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)
686               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)  
687               zcoefh(i, k) = zcoefh(i, k) + ycoefh(j, k)               zcoefh(i, k) = zcoefh(i, k) + ycoefh(j, k)
688            END DO            END DO
689         END DO         END DO
# Line 740  contains Line 700  contains
700                 1)))*(ypaprs(j, 1)-ypplay(j, 1))                 1)))*(ypaprs(j, 1)-ypplay(j, 1))
701            tairsol(j) = yts(j) + y_d_ts(j)            tairsol(j) = yts(j) + y_d_ts(j)
702            rugo1(j) = yrugos(j)            rugo1(j) = yrugos(j)
703            IF (nsrf==is_oce) THEN            IF (nsrf == is_oce) THEN
704               rugo1(j) = rugos(i, nsrf)               rugo1(j) = rugos(i, nsrf)
705            END IF            END IF
706            psfce(j) = ypaprs(j, 1)            psfce(j) = ypaprs(j, 1)
# Line 752  contains Line 712  contains
712         CALL stdlevvar(klon, knon, nsrf, zxli, uzon, vmer, tair1, qair1, zgeo1, &         CALL stdlevvar(klon, knon, nsrf, zxli, uzon, vmer, tair1, qair1, zgeo1, &
713              tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, yt10m, yq10m, &              tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, yt10m, yq10m, &
714              yu10m, yustar)              yu10m, yustar)
        !IM 081204 END  
715    
716         DO j = 1, knon         DO j = 1, knon
717            i = ni(j)            i = ni(j)
# Line 794  contains Line 753  contains
753            END DO            END DO
754         END DO         END DO
755         !IM "slab" ocean         !IM "slab" ocean
756         IF (nsrf==is_oce) THEN         IF (nsrf == is_oce) THEN
757            DO j = 1, knon            DO j = 1, knon
758               ! on projette sur la grille globale               ! on projette sur la grille globale
759               i = ni(j)               i = ni(j)
# Line 806  contains Line 765  contains
765            END DO            END DO
766         END IF         END IF
767    
768         IF (nsrf==is_sic) THEN         IF (nsrf == is_sic) THEN
769            DO j = 1, knon            DO j = 1, knon
770               i = ni(j)               i = ni(j)
771               ! 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)  
772               IF (pctsrf_new(i, is_sic)>epsfra) THEN               IF (pctsrf_new(i, is_sic)>epsfra) THEN
773                  flux_g(i) = y_flux_g(j)                  flux_g(i) = y_flux_g(j)
774               ELSE               ELSE
# Line 819  contains Line 777  contains
777            END DO            END DO
778    
779         END IF         END IF
780         !nsrf.EQ.is_sic                                                     IF (ocean == 'slab  ') THEN
781         IF (ocean=='slab  ') THEN            IF (nsrf == is_oce) THEN
           IF (nsrf==is_oce) THEN  
782               tslab(1:klon) = ytslab(1:klon)               tslab(1:klon) = ytslab(1:klon)
783               seaice(1:klon) = y_seaice(1:klon)               seaice(1:klon) = y_seaice(1:klon)
              !nsrf                                                        
784            END IF            END IF
           !OCEAN                                                        
785         END IF         END IF
786      END DO      END DO loop_surface
787    
788      ! On utilise les nouvelles surfaces      ! On utilise les nouvelles surfaces
     ! A rajouter: conservation de l'albedo  
789    
790      rugos(:, is_oce) = rugmer      rugos(:, is_oce) = rugmer
791      pctsrf = pctsrf_new      pctsrf = pctsrf_new
Legend:
Removed from v.40  
changed lines
  Added in v.61
  ViewVC Help
Powered by ViewVC 1.1.21