/[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 46 by guez, Tue Feb 22 13:49:36 2011 UTC revision 47 by guez, Fri Jul 1 15:00:48 2011 UTC
# 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)
# Line 436  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 468  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 500  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 513  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 568  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 624  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 645  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 676  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 692  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 718  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 740  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 752  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 794  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 806  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 819  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.46  
changed lines
  Added in v.47
  ViewVC Help
Powered by ViewVC 1.1.21