/[lmdze]/trunk/libf/phylmd/clmain.f90
ViewVC logotype

Diff of /trunk/libf/phylmd/clmain.f90

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

revision 38 by guez, Thu Jan 6 17:52:19 2011 UTC revision 47 by guez, Fri Jul 1 15:00:48 2011 UTC
# Line 16  contains Line 16  contains
16         fqcalving, ffonte, run_off_lic_0, flux_o, flux_g, tslab, seaice)         fqcalving, ffonte, run_off_lic_0, flux_o, flux_g, tslab, seaice)
17    
18      ! From phylmd/clmain.F, version 1.6 2005/11/16 14:47:19      ! From phylmd/clmain.F, version 1.6 2005/11/16 14:47:19
19        ! Author: Z.X. Li (LMD/CNRS), date: 1993/08/18
20        ! Objet : interface de "couche limite" (diffusion verticale)
21    
22      ! Tout ce qui a trait aux traceurs est dans phytrac maintenant.      ! Tout ce qui a trait aux traceurs est dans "phytrac" maintenant.
23      ! Pour l'instant le calcul de la couche limite pour les traceurs      ! Pour l'instant le calcul de la couche limite pour les traceurs
24      ! se fait avec cltrac et ne tient pas compte de la différentiation      ! se fait avec "cltrac" et ne tient pas compte de la différentiation
25      ! des sous-fractions de sol.      ! des sous-fractions de sol.
26    
27      ! Pour pouvoir extraire les coefficients d'échanges et le vent      ! Pour pouvoir extraire les coefficients d'échanges et le vent
28      ! dans la première couche, trois champs supplémentaires ont été créés :      ! dans la première couche, trois champs supplémentaires ont été
29      ! zcoefh, zu1 et zv1. Pour l'instant nous avons moyenné les valeurs      ! créés : "zcoefh", "zu1" et "zv1". Pour l'instant nous avons
30      ! de ces trois champs sur les 4 sous-surfaces du modèle. Dans l'avenir      ! moyenné les valeurs de ces trois champs sur les 4 sous-surfaces
31      ! si les informations des sous-surfaces doivent être prises en compte      ! du modèle. Dans l'avenir, si les informations des sous-surfaces
32      ! il faudra sortir ces mêmes champs en leur ajoutant une dimension,      ! doivent être prises en compte, il faudra sortir ces mêmes champs
33      ! c'est a dire nbsrf (nombre de sous-surfaces).      ! en leur ajoutant une dimension, c'est-à-dire "nbsrf" (nombre de
34        ! sous-surfaces).
     ! Auteur Z.X. Li (LMD/CNRS) date: 1993/08/18  
     ! Objet : interface de "couche limite" (diffusion verticale)  
35    
36      ! Arguments:      ! Arguments:
37      ! dtime----input-R- interval du temps (secondes)      ! dtime----input-R- interval du temps (secondes)
# Line 92  contains Line 92  contains
92      ! pblh------- HCL      ! pblh------- HCL
93      ! pblT------- T au nveau HCL      ! pblT------- T au nveau HCL
94    
     USE histcom, ONLY : histbeg_totreg, histdef, histend, histsync  
     use histwrite_m, only: histwrite  
95      use calendar, ONLY : ymds2ju      use calendar, ONLY : ymds2ju
96        use coefkz_m, only: coefkz
97        use coefkzmin_m, only: coefkzmin
98        USE conf_phys_m, ONLY : iflag_pbl
99      USE dimens_m, ONLY : iim, jjm      USE dimens_m, ONLY : iim, jjm
     USE indicesol, ONLY : epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf  
100      USE dimphy, ONLY : klev, klon, zmasq      USE dimphy, ONLY : klev, klon, zmasq
101      USE dimsoil, ONLY : nsoilmx      USE dimsoil, ONLY : nsoilmx
     USE temps, ONLY : annee_ref, itau_phy  
102      USE dynetat0_m, ONLY : day_ini      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  
103      USE gath_cpl, ONLY : gath2cpl      USE gath_cpl, ONLY : gath2cpl
104      use hbtm_m, only: hbtm      use hbtm_m, only: hbtm
105        USE histcom, ONLY : histbeg_totreg, histdef, histend, histsync
106        use histwrite_m, only: histwrite
107        USE indicesol, ONLY : epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf
108        USE iniprint, ONLY : prt_level
109        USE suphec_m, ONLY : rd, rg, rkappa
110        USE temps, ONLY : annee_ref, itau_phy
111        use yamada4_m, only: yamada4
112    
113      REAL, INTENT (IN) :: dtime      REAL, INTENT (IN) :: dtime
114      REAL date0      REAL date0
115      INTEGER, INTENT (IN) :: itap      INTEGER, INTENT (IN) :: itap
116      REAL t(klon, klev), q(klon, klev)      REAL t(klon, klev), q(klon, klev)
117      REAL u(klon, klev), v(klon, klev)      REAL, INTENT (IN):: u(klon, klev), v(klon, klev)
118      REAL, INTENT (IN) :: paprs(klon, klev+1)      REAL, INTENT (IN):: paprs(klon, klev+1)
119      REAL, INTENT (IN) :: pplay(klon, klev)      REAL, INTENT (IN):: pplay(klon, klev)
120      REAL, INTENT (IN) :: rlon(klon), rlat(klon)      REAL, INTENT (IN):: rlon(klon), rlat(klon)
121      REAL cufi(klon), cvfi(klon)      REAL cufi(klon), cvfi(klon)
122      REAL d_t(klon, klev), d_q(klon, klev)      REAL d_t(klon, klev), d_q(klon, klev)
123      REAL d_u(klon, klev), d_v(klon, klev)      REAL d_u(klon, klev), d_v(klon, klev)
# Line 179  contains Line 182  contains
182      REAL ytsoil(klon, nsoilmx)      REAL ytsoil(klon, nsoilmx)
183      REAL qsol(klon)      REAL qsol(klon)
184    
185      EXTERNAL clqh, clvent, coefkz, calbeta, cltrac      EXTERNAL clqh, clvent, calbeta, cltrac
186    
187      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)      REAL yts(klon), yrugos(klon), ypct(klon), yz0_new(klon)
188      REAL yalb(klon)      REAL yalb(klon)
# Line 208  contains Line 211  contains
211      PARAMETER (ok_nonloc=.FALSE.)      PARAMETER (ok_nonloc=.FALSE.)
212      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)      REAL ycoefm0(klon, klev), ycoefh0(klon, klev)
213    
     !IM 081204 hcl_Anne ? BEG  
214      REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev)      REAL yzlay(klon, klev), yzlev(klon, klev+1), yteta(klon, klev)
215      REAL ykmm(klon, klev+1), ykmn(klon, klev+1)      REAL ykmm(klon, klev+1), ykmn(klon, klev+1)
216      REAL ykmq(klon, klev+1)      REAL ykmq(klon, klev+1)
217      REAL yq2(klon, klev+1), q2(klon, klev+1, nbsrf)      REAL yq2(klon, klev+1), q2(klon, klev+1, nbsrf)
218      REAL q2diag(klon, klev+1)      REAL q2diag(klon, klev+1)
     !IM 081204 hcl_Anne ? END  
219    
220      REAL u1lay(klon), v1lay(klon)      REAL u1lay(klon), v1lay(klon)
221      REAL delp(klon, klev)      REAL delp(klon, klev)
222      INTEGER i, k, nsrf      INTEGER i, k, nsrf
223    
224      INTEGER ni(klon), knon, j      INTEGER ni(klon), knon, j
225      ! Introduction d'une variable "pourcentage potentiel" pour tenir compte  
     ! des eventuelles apparitions et/ou disparitions de la glace de mer  
226      REAL pctsrf_pot(klon, nbsrf)      REAL pctsrf_pot(klon, nbsrf)
227        ! "pourcentage potentiel" pour tenir compte des éventuelles
228        ! apparitions ou disparitions de la glace de mer
229    
230      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.
231    
# Line 298  contains Line 300  contains
300    
301      !------------------------------------------------------------      !------------------------------------------------------------
302    
     ! initialisation Anne  
303      ytherm = 0.      ytherm = 0.
304    
305      IF (debugindex .AND. first_appel) THEN      IF (debugindex .AND. first_appel) THEN
# Line 307  contains Line 308  contains
308         ! initialisation sorties netcdf         ! initialisation sorties netcdf
309    
310         idayref = day_ini         idayref = day_ini
311         CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)         CALL ymds2ju(annee_ref, 1, idayref, 0., zjulian)
312         CALL gr_fi_ecrit(1, klon, iim, jjm+1, rlon, zx_lon)         CALL gr_fi_ecrit(1, klon, iim, jjm+1, rlon, zx_lon)
313         DO i = 1, iim         DO i = 1, iim
314            zx_lon(i, 1) = rlon(i+1)            zx_lon(i, 1) = rlon(i+1)
# Line 342  contains Line 343  contains
343         v1lay(i) = v(i, 1)*zx_alf1 + v(i, 2)*zx_alf2         v1lay(i) = v(i, 1)*zx_alf1 + v(i, 2)*zx_alf2
344      END DO      END DO
345    
346      ! initialisation:      ! Initialization:
347        rugmer = 0.
348      DO i = 1, klon      cdragh = 0.
349         rugmer(i) = 0.0      cdragm = 0.
350         cdragh(i) = 0.0      dflux_t = 0.
351         cdragm(i) = 0.0      dflux_q = 0.
352         dflux_t(i) = 0.0      zu1 = 0.
353         dflux_q(i) = 0.0      zv1 = 0.
354         zu1(i) = 0.0      ypct = 0.
355         zv1(i) = 0.0      yts = 0.
356      END DO      ysnow = 0.
357      ypct = 0.0      yqsurf = 0.
358      yts = 0.0      yalb = 0.
359      ysnow = 0.0      yalblw = 0.
360      yqsurf = 0.0      yrain_f = 0.
361      yalb = 0.0      ysnow_f = 0.
362      yalblw = 0.0      yfder = 0.
363      yrain_f = 0.0      ytaux = 0.
364      ysnow_f = 0.0      ytauy = 0.
365      yfder = 0.0      ysolsw = 0.
366      ytaux = 0.0      ysollw = 0.
367      ytauy = 0.0      ysollwdown = 0.
368      ysolsw = 0.0      yrugos = 0.
369      ysollw = 0.0      yu1 = 0.
370      ysollwdown = 0.0      yv1 = 0.
371      yrugos = 0.0      yrads = 0.
372      yu1 = 0.0      ypaprs = 0.
373      yv1 = 0.0      ypplay = 0.
374      yrads = 0.0      ydelp = 0.
375      ypaprs = 0.0      yu = 0.
376      ypplay = 0.0      yv = 0.
377      ydelp = 0.0      yt = 0.
378      yu = 0.0      yq = 0.
379      yv = 0.0      pctsrf_new = 0.
380      yt = 0.0      y_flux_u = 0.
381      yq = 0.0      y_flux_v = 0.
     pctsrf_new = 0.0  
     y_flux_u = 0.0  
     y_flux_v = 0.0  
382      !$$ PB      !$$ PB
383      y_dflux_t = 0.0      y_dflux_t = 0.
384      y_dflux_q = 0.0      y_dflux_q = 0.
385      ytsoil = 999999.      ytsoil = 999999.
386      yrugoro = 0.      yrugoro = 0.
387      ! -- LOOP      ! -- LOOP
388      yu10mx = 0.0      yu10mx = 0.
389      yu10my = 0.0      yu10my = 0.
390      ywindsp = 0.0      ywindsp = 0.
391      ! -- LOOP      ! -- LOOP
392      DO nsrf = 1, nbsrf      d_ts = 0.
        DO i = 1, klon  
           d_ts(i, nsrf) = 0.0  
        END DO  
     END DO  
393      !§§§ PB      !§§§ PB
394      yfluxlat = 0.      yfluxlat = 0.
395      flux_t = 0.      flux_t = 0.
396      flux_q = 0.      flux_q = 0.
397      flux_u = 0.      flux_u = 0.
398      flux_v = 0.      flux_v = 0.
399      DO k = 1, klev      d_t = 0.
400         DO i = 1, klon      d_q = 0.
401            d_t(i, k) = 0.0      d_u = 0.
402            d_q(i, k) = 0.0      d_v = 0.
403            d_u(i, k) = 0.0      zcoefh = 0.
           d_v(i, k) = 0.0  
           zcoefh(i, k) = 0.0  
        END DO  
     END DO  
404    
405      ! Boucler sur toutes les sous-fractions du sol:      ! Boucler sur toutes les sous-fractions du sol:
406    
# Line 427  contains Line 417  contains
417         ni = 0         ni = 0
418         knon = 0         knon = 0
419         DO i = 1, klon         DO i = 1, klon
420            ! pour determiner le domaine a traiter on utilise les surfaces            ! Pour déterminer le domaine à traiter, on utilise les surfaces
421            ! "potentielles"            ! "potentielles"
422            IF (pctsrf_pot(i, nsrf) > epsfra) THEN            IF (pctsrf_pot(i, nsrf) > epsfra) THEN
423               knon = knon + 1               knon = knon + 1
# Line 447  contains Line 437  contains
437            CALL histwrite(nidbg, cl_surf(nsrf), itap, debugtab)            CALL histwrite(nidbg, cl_surf(nsrf), itap, debugtab)
438         END IF         END IF
439    
440         IF (knon==0) CYCLE         IF (knon == 0) CYCLE
441    
442         DO j = 1, knon         DO j = 1, knon
443            i = ni(j)            i = ni(j)
# Line 479  contains Line 469  contains
469            ywindsp(j) = sqrt(yu10mx(j)*yu10mx(j)+yu10my(j)*yu10my(j))            ywindsp(j) = sqrt(yu10mx(j)*yu10mx(j)+yu10my(j)*yu10my(j))
470         END DO         END DO
471    
472         !     IF bucket model for continent, copy soil water content         ! IF bucket model for continent, copy soil water content
473         IF (nsrf==is_ter .AND. .NOT. ok_veget) THEN         IF (nsrf == is_ter .AND. .NOT. ok_veget) THEN
474            DO j = 1, knon            DO j = 1, knon
475               i = ni(j)               i = ni(j)
476               yqsol(j) = qsol(i)               yqsol(j) = qsol(i)
# Line 511  contains Line 501  contains
501         ! calculer Cdrag et les coefficients d'echange         ! calculer Cdrag et les coefficients d'echange
502         CALL coefkz(nsrf, knon, ypaprs, ypplay, ksta, ksta_ter, yts,&         CALL coefkz(nsrf, knon, ypaprs, ypplay, ksta, ksta_ter, yts,&
503              yrugos, yu, yv, yt, yq, yqsurf, ycoefm, ycoefh)              yrugos, yu, yv, yt, yq, yqsurf, ycoefm, ycoefh)
504         !IM 081204 BEG         IF (iflag_pbl == 1) THEN
        !CR test  
        IF (iflag_pbl==1) THEN  
           !IM 081204 END  
505            CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)            CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, ycoefm0, ycoefh0)
506            DO k = 1, klev            DO k = 1, klev
507               DO i = 1, knon               DO i = 1, knon
# Line 524  contains Line 511  contains
511            END DO            END DO
512         END IF         END IF
513    
514         !IM cf JLD : on seuille ycoefm et ycoefh         ! on seuille ycoefm et ycoefh
515         IF (nsrf==is_oce) THEN         IF (nsrf == is_oce) THEN
516            DO j = 1, knon            DO j = 1, knon
              !           ycoefm(j, 1)=min(ycoefm(j, 1), 1.1E-3)  
517               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)  
518               ycoefh(j, 1) = min(ycoefh(j, 1), cdhmax)               ycoefh(j, 1) = min(ycoefh(j, 1), cdhmax)
519            END DO            END DO
520         END IF         END IF
521    
        !IM: 261103  
522         IF (ok_kzmin) THEN         IF (ok_kzmin) THEN
523            !IM cf FH: 201103 BEG            ! Calcul d'une diffusion minimale pour les conditions tres stables
524            !   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, &  
525                 ycoefm0, ycoefh0)                 ycoefm0, ycoefh0)
526    
527            IF (1==1) THEN            DO k = 1, klev
528               DO k = 1, klev               DO i = 1, knon
529                  DO i = 1, knon                  ycoefm(i, k) = max(ycoefm(i, k), ycoefm0(i, k))
530                     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  
531               END DO               END DO
532            END IF            END DO
533            !IM cf FH: 201103 END         END IF
           !IM: 261103  
        END IF !ok_kzmin  
534    
535         IF (iflag_pbl>=3) THEN         IF (iflag_pbl >= 3) THEN
536            ! MELLOR ET YAMADA adapté à Mars, Richard Fournier et Frédéric Hourdin            ! MELLOR ET YAMADA adapté à Mars, Richard Fournier et Frédéric Hourdin
537            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, &
538                 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 579  contains Line 558  contains
558               END DO               END DO
559            END DO            END DO
560    
561            !   Bug introduit volontairement pour converger avec les resultats            y_cd_m(1:knon) = ycoefm(1:knon, 1)
562            !  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  
563            CALL ustarhb(knon, yu, yv, y_cd_m, yustar)            CALL ustarhb(knon, yu, yv, y_cd_m, yustar)
564    
565            IF (prt_level>9) THEN            IF (prt_level>9) THEN
566               PRINT *, 'USTAR = ', yustar               PRINT *, 'USTAR = ', yustar
567            END IF            END IF
568    
569            !   iflag_pbl peut etre utilise comme longuer de melange            ! iflag_pbl peut être utilisé comme longueur de mélange
570    
571            IF (iflag_pbl>=11) THEN            IF (iflag_pbl >= 11) THEN
572               CALL vdif_kcay(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, &               CALL vdif_kcay(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, &
573                    yu, yv, yteta, y_cd_m, yq2, q2diag, ykmm, ykmn, yustar, &                    yu, yv, yteta, y_cd_m, yq2, q2diag, ykmm, ykmn, yustar, &
574                    iflag_pbl)                    iflag_pbl)
575            ELSE            ELSE
576               CALL yamada4(knon, dtime, rg, rd, ypaprs, yt, yzlev, yzlay, yu, &               CALL yamada4(knon, dtime, rg, yzlev, yzlay, yu, yv, yteta, &
577                    yv, yteta, y_cd_m, yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)                    y_cd_m, yq2, ykmm, ykmn, ykmq, yustar, iflag_pbl)
578            END IF            END IF
579    
580            ycoefm(1:knon, 1) = y_cd_m(1:knon)            ycoefm(1:knon, 1) = y_cd_m(1:knon)
# Line 621  contains Line 593  contains
593         ytaux = y_flux_u(:, 1)         ytaux = y_flux_u(:, 1)
594         ytauy = y_flux_v(:, 1)         ytauy = y_flux_v(:, 1)
595    
        ! FH modif sur le cdrag temperature  
        !$$$PB : déplace dans clcdrag  
        !$$$      do i=1, knon  
        !$$$         ycoefh(i, 1)=ycoefm(i, 1)*0.8  
        !$$$      enddo  
   
596         ! calculer la diffusion de "q" et de "h"         ! calculer la diffusion de "q" et de "h"
597         CALL clqh(dtime, itap, date0, jour, debut, lafin, rlon, rlat,&         CALL clqh(dtime, itap, date0, jour, debut, lafin, rlon, rlat,&
598              cufi, cvfi, knon, nsrf, ni, pctsrf, soil_model, ytsoil,&              cufi, cvfi, knon, nsrf, ni, pctsrf, soil_model, ytsoil,&
# Line 641  contains Line 607  contains
607    
608         ! calculer la longueur de rugosite sur ocean         ! calculer la longueur de rugosite sur ocean
609         yrugm = 0.         yrugm = 0.
610         IF (nsrf==is_oce) THEN         IF (nsrf == is_oce) THEN
611            DO j = 1, knon            DO j = 1, knon
612               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 + &
613                    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 662  contains Line 628  contains
628               ycoefm(j, k) = ycoefm(j, k)*ypct(j)               ycoefm(j, k) = ycoefm(j, k)*ypct(j)
629               y_d_t(j, k) = y_d_t(j, k)*ypct(j)               y_d_t(j, k) = y_d_t(j, k)*ypct(j)
630               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  
631               flux_t(i, k, nsrf) = y_flux_t(j, k)               flux_t(i, k, nsrf) = y_flux_t(j, k)
632               flux_q(i, k, nsrf) = y_flux_q(j, k)               flux_q(i, k, nsrf) = y_flux_q(j, k)
633               flux_u(i, k, nsrf) = y_flux_u(j, k)               flux_u(i, k, nsrf) = y_flux_u(j, k)
634               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)  
635               y_d_u(j, k) = y_d_u(j, k)*ypct(j)               y_d_u(j, k) = y_d_u(j, k)*ypct(j)
636               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)  
637            END DO            END DO
638         END DO         END DO
639    
# Line 693  contains Line 654  contains
654            qsurf(i, nsrf) = yqsurf(j)            qsurf(i, nsrf) = yqsurf(j)
655            rugos(i, nsrf) = yz0_new(j)            rugos(i, nsrf) = yz0_new(j)
656            fluxlat(i, nsrf) = yfluxlat(j)            fluxlat(i, nsrf) = yfluxlat(j)
657            !$$$ pb         rugmer(i) = yrugm(j)            IF (nsrf == is_oce) THEN
           IF (nsrf==is_oce) THEN  
658               rugmer(i) = yrugm(j)               rugmer(i) = yrugm(j)
659               rugos(i, nsrf) = yrugm(j)               rugos(i, nsrf) = yrugm(j)
660            END IF            END IF
           !IM cf JLD ??  
661            agesno(i, nsrf) = yagesno(j)            agesno(i, nsrf) = yagesno(j)
662            fqcalving(i, nsrf) = y_fqcalving(j)            fqcalving(i, nsrf) = y_fqcalving(j)
663            ffonte(i, nsrf) = y_ffonte(j)            ffonte(i, nsrf) = y_ffonte(j)
# Line 709  contains Line 668  contains
668            zu1(i) = zu1(i) + yu1(j)            zu1(i) = zu1(i) + yu1(j)
669            zv1(i) = zv1(i) + yv1(j)            zv1(i) = zv1(i) + yv1(j)
670         END DO         END DO
671         IF (nsrf==is_ter) THEN         IF (nsrf == is_ter) THEN
672            DO j = 1, knon            DO j = 1, knon
673               i = ni(j)               i = ni(j)
674               qsol(i) = yqsol(j)               qsol(i) = yqsol(j)
675            END DO            END DO
676         END IF         END IF
677         IF (nsrf==is_lic) THEN         IF (nsrf == is_lic) THEN
678            DO j = 1, knon            DO j = 1, knon
679               i = ni(j)               i = ni(j)
680               run_off_lic_0(i) = y_run_off_lic_0(j)               run_off_lic_0(i) = y_run_off_lic_0(j)
# Line 735  contains Line 694  contains
694            DO k = 1, klev            DO k = 1, klev
695               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)
696               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)  
697               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)
698               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)  
699               zcoefh(i, k) = zcoefh(i, k) + ycoefh(j, k)               zcoefh(i, k) = zcoefh(i, k) + ycoefh(j, k)
700            END DO            END DO
701         END DO         END DO
# Line 757  contains Line 712  contains
712                 1)))*(ypaprs(j, 1)-ypplay(j, 1))                 1)))*(ypaprs(j, 1)-ypplay(j, 1))
713            tairsol(j) = yts(j) + y_d_ts(j)            tairsol(j) = yts(j) + y_d_ts(j)
714            rugo1(j) = yrugos(j)            rugo1(j) = yrugos(j)
715            IF (nsrf==is_oce) THEN            IF (nsrf == is_oce) THEN
716               rugo1(j) = rugos(i, nsrf)               rugo1(j) = rugos(i, nsrf)
717            END IF            END IF
718            psfce(j) = ypaprs(j, 1)            psfce(j) = ypaprs(j, 1)
# Line 769  contains Line 724  contains
724         CALL stdlevvar(klon, knon, nsrf, zxli, uzon, vmer, tair1, qair1, zgeo1, &         CALL stdlevvar(klon, knon, nsrf, zxli, uzon, vmer, tair1, qair1, zgeo1, &
725              tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, yt10m, yq10m, &              tairsol, qairsol, rugo1, psfce, patm, yt2m, yq2m, yt10m, yq10m, &
726              yu10m, yustar)              yu10m, yustar)
        !IM 081204 END  
727    
728         DO j = 1, knon         DO j = 1, knon
729            i = ni(j)            i = ni(j)
# Line 811  contains Line 765  contains
765            END DO            END DO
766         END DO         END DO
767         !IM "slab" ocean         !IM "slab" ocean
768         IF (nsrf==is_oce) THEN         IF (nsrf == is_oce) THEN
769            DO j = 1, knon            DO j = 1, knon
770               ! on projette sur la grille globale               ! on projette sur la grille globale
771               i = ni(j)               i = ni(j)
# Line 823  contains Line 777  contains
777            END DO            END DO
778         END IF         END IF
779    
780         IF (nsrf==is_sic) THEN         IF (nsrf == is_sic) THEN
781            DO j = 1, knon            DO j = 1, knon
782               i = ni(j)               i = ni(j)
783               ! 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)  
784               IF (pctsrf_new(i, is_sic)>epsfra) THEN               IF (pctsrf_new(i, is_sic)>epsfra) THEN
785                  flux_g(i) = y_flux_g(j)                  flux_g(i) = y_flux_g(j)
786               ELSE               ELSE
# Line 836  contains Line 789  contains
789            END DO            END DO
790    
791         END IF         END IF
792         !nsrf.EQ.is_sic                                                     IF (ocean == 'slab  ') THEN
793         IF (ocean=='slab  ') THEN            IF (nsrf == is_oce) THEN
           IF (nsrf==is_oce) THEN  
794               tslab(1:klon) = ytslab(1:klon)               tslab(1:klon) = ytslab(1:klon)
795               seaice(1:klon) = y_seaice(1:klon)               seaice(1:klon) = y_seaice(1:klon)
              !nsrf                                                        
796            END IF            END IF
           !OCEAN                                                        
797         END IF         END IF
798      END DO      END DO
799    
800      ! On utilise les nouvelles surfaces      ! On utilise les nouvelles surfaces
     ! A rajouter: conservation de l'albedo  
801    
802      rugos(:, is_oce) = rugmer      rugos(:, is_oce) = rugmer
803      pctsrf = pctsrf_new      pctsrf = pctsrf_new
Legend:
Removed from v.38  
changed lines
  Added in v.47
  ViewVC Help
Powered by ViewVC 1.1.21