/[lmdze]/trunk/phylmd/physiq.f90
ViewVC logotype

Diff of /trunk/phylmd/physiq.f90

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

revision 68 by guez, Wed Nov 14 16:59:30 2012 UTC revision 70 by guez, Mon Jun 24 15:39:52 2013 UTC
# Line 56  contains Line 56  contains
56      USE phytrac_m, ONLY: phytrac      USE phytrac_m, ONLY: phytrac
57      USE qcheck_m, ONLY: qcheck      USE qcheck_m, ONLY: qcheck
58      use radlwsw_m, only: radlwsw      use radlwsw_m, only: radlwsw
59        use readsulfate_m, only: readsulfate
60      use sugwd_m, only: sugwd      use sugwd_m, only: sugwd
61      USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt      USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt
62      USE temps, ONLY: annee_ref, day_ref, itau_phy      USE temps, ONLY: annee_ref, day_ref, itau_phy
# Line 123  contains Line 124  contains
124      character(len = 6):: ocean = 'force '      character(len = 6):: ocean = 'force '
125      ! (type de modèle océan à utiliser: "force" ou "slab" mais pas "couple")      ! (type de modèle océan à utiliser: "force" ou "slab" mais pas "couple")
126    
     logical ok_ocean  
     SAVE ok_ocean  
   
127      ! "slab" ocean      ! "slab" ocean
128      REAL, save:: tslab(klon) ! temperature of ocean slab      REAL, save:: tslab(klon) ! temperature of ocean slab
129      REAL, save:: seaice(klon) ! glace de mer (kg/m2)      REAL, save:: seaice(klon) ! glace de mer (kg/m2)
# Line 169  contains Line 167  contains
167    
168      !MI Amip2 PV a theta constante      !MI Amip2 PV a theta constante
169    
170      INTEGER klevp1      REAL swdn0(klon, llm + 1), swdn(klon, llm + 1)
171      PARAMETER(klevp1 = llm + 1)      REAL swup0(klon, llm + 1), swup(klon, llm + 1)
   
     REAL swdn0(klon, klevp1), swdn(klon, klevp1)  
     REAL swup0(klon, klevp1), swup(klon, klevp1)  
172      SAVE swdn0, swdn, swup0, swup      SAVE swdn0, swdn, swup0, swup
173    
174      REAL lwdn0(klon, klevp1), lwdn(klon, klevp1)      REAL lwdn0(klon, llm + 1), lwdn(klon, llm + 1)
175      REAL lwup0(klon, klevp1), lwup(klon, klevp1)      REAL lwup0(klon, llm + 1), lwup(klon, llm + 1)
176      SAVE lwdn0, lwdn, lwup0, lwup      SAVE lwdn0, lwdn, lwup0, lwup
177    
178      !IM Amip2      !IM Amip2
# Line 320  contains Line 315  contains
315      SAVE qcondc      SAVE qcondc
316      REAL ema_work1(klon, llm), ema_work2(klon, llm)      REAL ema_work1(klon, llm), ema_work2(klon, llm)
317      SAVE ema_work1, ema_work2      SAVE ema_work1, ema_work2
318        REAL, save:: wd(klon)
     REAL wd(klon) ! sb  
     SAVE wd ! sb  
319    
320      ! Variables locales pour la couche limite (al1):      ! Variables locales pour la couche limite (al1):
321    
# Line 331  contains Line 324  contains
324      REAL cdragh(klon) ! drag coefficient pour T and Q      REAL cdragh(klon) ! drag coefficient pour T and Q
325      REAL cdragm(klon) ! drag coefficient pour vent      REAL cdragm(klon) ! drag coefficient pour vent
326    
327      !AA Pour phytrac      ! Pour phytrac :
328      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac
329      REAL yu1(klon) ! vents dans la premiere couche U      REAL yu1(klon) ! vents dans la premiere couche U
330      REAL yv1(klon) ! vents dans la premiere couche V      REAL yv1(klon) ! vents dans la premiere couche V
# Line 376  contains Line 369  contains
369      INTEGER julien      INTEGER julien
370    
371      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day
372      REAL pctsrf(klon, nbsrf)      REAL, save:: pctsrf(klon, nbsrf) ! percentage of surface
373      !IM      REAL pctsrf_new(klon, nbsrf) ! pourcentage surfaces issus d'ORCHIDEE
     REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE  
374    
     SAVE pctsrf ! sous-fraction du sol  
375      REAL albsol(klon)      REAL albsol(klon)
376      SAVE albsol ! albedo du sol total      SAVE albsol ! albedo du sol total
377      REAL albsollw(klon)      REAL albsollw(klon)
# Line 450  contains Line 441  contains
441      REAL dist, rmu0(klon), fract(klon)      REAL dist, rmu0(klon), fract(klon)
442      REAL zdtime ! pas de temps du rayonnement (s)      REAL zdtime ! pas de temps du rayonnement (s)
443      real zlongi      real zlongi
   
444      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
     LOGICAL zx_ajustq  
   
445      REAL za, zb      REAL za, zb
446      REAL zx_t, zx_qs, zdelta, zcor      REAL zx_t, zx_qs, zdelta, zcor
447      real zqsat(klon, llm)      real zqsat(klon, llm)
448      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
449      REAL t_coup      REAL, PARAMETER:: t_coup = 234.
     PARAMETER (t_coup = 234.0)  
   
450      REAL zphi(klon, llm)      REAL zphi(klon, llm)
451    
452      !IM cf. AM Variables locales pour la CLA (hbtm2)      !IM cf. AM Variables locales pour la CLA (hbtm2)
# Line 497  contains Line 483  contains
483      REAL rflag(klon) ! flag fonctionnement de convect      REAL rflag(klon) ! flag fonctionnement de convect
484      INTEGER iflagctrl(klon) ! flag fonctionnement de convect      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
485      ! -- convect43:      ! -- convect43:
     INTEGER ntra ! nb traceurs pour convect4.3  
486      REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)      REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)
487      REAL dplcldt(klon), dplcldr(klon)      REAL dplcldt(klon), dplcldr(klon)
488    
# Line 579  contains Line 564  contains
564    
565      REAL zsto      REAL zsto
566    
     character(len = 20) modname  
     character(len = 80) abort_message  
567      logical ok_sync      logical ok_sync
568      real date0      real date0
569    
# Line 598  contains Line 581  contains
581      REAL ZRCPD      REAL ZRCPD
582    
583      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m      REAL t2m(klon, nbsrf), q2m(klon, nbsrf) ! temperature and humidity at 2 m
584      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m
585      REAL zt2m(klon), zq2m(klon) !temp., hum. 2m moyenne s/ 1 maille      REAL zt2m(klon), zq2m(klon) ! temp., hum. 2 m moyenne s/ 1 maille
586      REAL zu10m(klon), zv10m(klon) !vents a 10m moyennes s/1 maille      REAL zu10m(klon), zv10m(klon) ! vents a 10 m moyennes s/1 maille
587      !jq Aerosol effects (Johannes Quaas, 27/11/2003)  
588      REAL sulfate(klon, llm) ! SO4 aerosol concentration [ug/m3]      ! Aerosol effects:
589    
590        REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g/m3)
591    
592      REAL, save:: sulfate_pi(klon, llm)      REAL, save:: sulfate_pi(klon, llm)
593      ! (SO4 aerosol concentration, in ug/m3, pre-industrial value)      ! SO4 aerosol concentration, in micro g/m3, pre-industrial value
594    
595      REAL cldtaupi(klon, llm)      REAL cldtaupi(klon, llm)
596      ! (Cloud optical thickness for pre-industrial (pi) aerosols)      ! cloud optical thickness for pre-industrial (pi) aerosols
597    
598      REAL re(klon, llm) ! Cloud droplet effective radius      REAL re(klon, llm) ! Cloud droplet effective radius
599      REAL fl(klon, llm) ! denominator of re      REAL fl(klon, llm) ! denominator of re
# Line 618  contains Line 603  contains
603      REAL, save:: cg_ae(klon, llm, 2)      REAL, save:: cg_ae(klon, llm, 2)
604    
605      REAL topswad(klon), solswad(klon) ! aerosol direct effect      REAL topswad(klon), solswad(klon) ! aerosol direct effect
     ! ok_ade --> ADE = topswad - topsw  
   
606      REAL topswai(klon), solswai(klon) ! aerosol indirect effect      REAL topswai(klon), solswai(klon) ! aerosol indirect effect
     ! ok_aie .and. ok_ade --> AIE = topswai - topswad  
     ! ok_aie .and. .not. ok_ade --> AIE = topswai - topsw  
607    
608      REAL aerindex(klon) ! POLDER aerosol index      REAL aerindex(klon) ! POLDER aerosol index
609    
# Line 630  contains Line 611  contains
611      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect
612    
613      REAL:: bl95_b0 = 2., bl95_b1 = 0.2      REAL:: bl95_b0 = 2., bl95_b1 = 0.2
614      ! Parameters in the formula to link CDNC to aerosol mass conc      ! Parameters in equation (D) of Boucher and Lohmann (1995, Tellus
615      ! (Boucher and Lohmann, 1995), used in nuage.F      ! B). They link cloud droplet number concentration to aerosol mass
616        ! concentration.
617    
618      SAVE u10m      SAVE u10m
619      SAVE v10m      SAVE v10m
# Line 662  contains Line 644  contains
644    
645      !----------------------------------------------------------------      !----------------------------------------------------------------
646    
647      modname = 'physiq'      IF (if_ebil >= 1) zero_v = 0.
     IF (if_ebil >= 1) THEN  
        DO i = 1, klon  
           zero_v(i) = 0.  
        END DO  
     END IF  
648      ok_sync = .TRUE.      ok_sync = .TRUE.
649      IF (nqmx < 2) THEN      IF (nqmx < 2) CALL abort_gcm('physiq', &
650         abort_message = 'eaux vapeur et liquide sont indispensables'           'eaux vapeur et liquide sont indispensables', 1)
        CALL abort_gcm(modname, abort_message, 1)  
     ENDIF  
651    
652      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
653         ! initialiser         ! initialiser
# Line 687  contains Line 662  contains
662         cg_ae = 0.         cg_ae = 0.
663         rain_con(:) = 0.         rain_con(:) = 0.
664         snow_con(:) = 0.         snow_con(:) = 0.
        bl95_b0 = 0.  
        bl95_b1 = 0.  
665         topswai(:) = 0.         topswai(:) = 0.
666         topswad(:) = 0.         topswad(:) = 0.
667         solswai(:) = 0.         solswai(:) = 0.
# Line 720  contains Line 693  contains
693         read(unit=*, nml=physiq_nml)         read(unit=*, nml=physiq_nml)
694         write(unit_nml, nml=physiq_nml)         write(unit_nml, nml=physiq_nml)
695    
        ! Appel à la lecture du run.def physique  
696         call conf_phys         call conf_phys
697    
698         ! Initialiser les compteurs:         ! Initialiser les compteurs:
# Line 735  contains Line 707  contains
707              ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0)              ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0)
708    
709         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
710         q2 = 1.e-8         q2 = 1e-8
711    
712         radpas = NINT(86400. / dtphys / nbapp_rad)         radpas = NINT(86400. / dtphys / nbapp_rad)
713    
# Line 743  contains Line 715  contains
715         IF (raz_date) itau_phy = 0         IF (raz_date) itau_phy = 0
716    
717         PRINT *, 'cycle_diurne = ', cycle_diurne         PRINT *, 'cycle_diurne = ', cycle_diurne
718           CALL printflag(radpas, ocean /= 'force', ok_oasis, ok_journe, &
719                ok_instan, ok_region)
720    
721         IF(ocean.NE.'force ') THEN         IF (dtphys * REAL(radpas) > 21600. .AND. cycle_diurne) THEN
           ok_ocean = .TRUE.  
        ENDIF  
   
        CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &  
             ok_region)  
   
        IF (dtphys*REAL(radpas) > 21600..AND.cycle_diurne) THEN  
           print *, 'Nbre d appels au rayonnement insuffisant'  
722            print *, "Au minimum 4 appels par jour si cycle diurne"            print *, "Au minimum 4 appels par jour si cycle diurne"
723            abort_message = 'Nbre d appels au rayonnement insuffisant'            call abort_gcm('physiq', &
724            call abort_gcm(modname, abort_message, 1)                 "Nombre d'appels au rayonnement insuffisant", 1)
725         ENDIF         ENDIF
        print *, "Clef pour la convection, iflag_con = ", iflag_con  
726    
727         ! Initialisation pour la convection de K.E. (sb):         ! Initialisation pour le schéma de convection d'Emanuel :
728         IF (iflag_con >= 3) THEN         IF (iflag_con >= 3) THEN
729            print *, "Convection de Kerry Emanuel 4.3"            ibas_con = 1
730              itop_con = 1
           DO i = 1, klon  
              ibas_con(i) = 1  
              itop_con(i) = 1  
           ENDDO  
731         ENDIF         ENDIF
732    
733         IF (ok_orodr) THEN         IF (ok_orodr) THEN
# Line 796  contains Line 757  contains
757         call ini_histday(dtphys, ok_journe, nid_day, nqmx)         call ini_histday(dtphys, ok_journe, nid_day, nqmx)
758         call ini_histins(dtphys, ok_instan, nid_ins)         call ini_histins(dtphys, ok_instan, nid_ins)
759         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
760         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         ! Positionner date0 pour initialisation de ORCHIDEE
761         WRITE(*, *) 'physiq date0: ', date0         print *, 'physiq date0: ', date0
762      ENDIF test_firstcal      ENDIF test_firstcal
763    
764      ! Mettre a zero des variables de sortie (pour securite)      ! Mettre a zero des variables de sortie (pour securite)
765    
766      DO i = 1, klon      DO i = 1, klon
767         d_ps(i) = 0.0         d_ps(i) = 0.
768      ENDDO      ENDDO
769      DO iq = 1, nqmx      DO iq = 1, nqmx
770         DO k = 1, llm         DO k = 1, llm
771            DO i = 1, klon            DO i = 1, klon
772               d_qx(i, k, iq) = 0.0               d_qx(i, k, iq) = 0.
773            ENDDO            ENDDO
774         ENDDO         ENDDO
775      ENDDO      ENDDO
# Line 893  contains Line 854  contains
854    
855      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg
856    
857      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! Mettre en action les conditions aux limites (albedo, sst etc.).
858    
859      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
860      wo = ozonecm(REAL(julien), paprs)      wo = ozonecm(REAL(julien), paprs)
# Line 962  contains Line 923  contains
923      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
924         DO i = 1, klon         DO i = 1, klon
925            fsollw(i, nsrf) = sollw(i) &            fsollw(i, nsrf) = sollw(i) &
926                 + 4.0*RSIGMA*ztsol(i)**3 * (ztsol(i)-ftsol(i, nsrf))                 + 4. * RSIGMA * ztsol(i)**3 * (ztsol(i) - ftsol(i, nsrf))
927            fsolsw(i, nsrf) = solsw(i)*(1.-falbe(i, nsrf))/(1.-albsol(i))            fsolsw(i, nsrf) = solsw(i) * (1. - falbe(i, nsrf)) / (1. - albsol(i))
928         ENDDO         ENDDO
929      ENDDO      ENDDO
930    
# Line 991  contains Line 952  contains
952      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
953         DO k = 1, llm         DO k = 1, llm
954            DO i = 1, klon            DO i = 1, klon
955               zxfluxt(i, k) = zxfluxt(i, k) + &               zxfluxt(i, k) = zxfluxt(i, k) + fluxt(i, k, nsrf) * pctsrf(i, nsrf)
956                    fluxt(i, k, nsrf) * pctsrf(i, nsrf)               zxfluxq(i, k) = zxfluxq(i, k) + fluxq(i, k, nsrf) * pctsrf(i, nsrf)
957               zxfluxq(i, k) = zxfluxq(i, k) + &               zxfluxu(i, k) = zxfluxu(i, k) + fluxu(i, k, nsrf) * pctsrf(i, nsrf)
958                    fluxq(i, k, nsrf) * pctsrf(i, nsrf)               zxfluxv(i, k) = zxfluxv(i, k) + fluxv(i, k, nsrf) * pctsrf(i, nsrf)
              zxfluxu(i, k) = zxfluxu(i, k) + &  
                   fluxu(i, k, nsrf) * pctsrf(i, nsrf)  
              zxfluxv(i, k) = zxfluxv(i, k) + &  
                   fluxv(i, k, nsrf) * pctsrf(i, nsrf)  
959            END DO            END DO
960         END DO         END DO
961      END DO      END DO
962      DO i = 1, klon      DO i = 1, klon
963         sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol         sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol
964         evap(i) = - zxfluxq(i, 1) ! flux d'evaporation au sol         evap(i) = - zxfluxq(i, 1) ! flux d'évaporation au sol
965         fder(i) = dlw(i) + dsens(i) + devap(i)         fder(i) = dlw(i) + dsens(i) + devap(i)
966      ENDDO      ENDDO
967    
# Line 1051  contains Line 1008  contains
1008         s_trmb2(i) = 0.0         s_trmb2(i) = 0.0
1009         s_trmb3(i) = 0.0         s_trmb3(i) = 0.0
1010    
1011         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + &         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + pctsrf(i, is_oce) &
1012              pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.)  >  EPSFRA) &              + pctsrf(i, is_sic) - 1.)  >  EPSFRA) print *, &
1013              THEN              'physiq : problème sous surface au point ', i, pctsrf(i, 1 : nbsrf)
           WRITE(*, *) 'physiq : pb sous surface au point ', i, &  
                pctsrf(i, 1 : nbsrf)  
        ENDIF  
1014      ENDDO      ENDDO
1015      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1016         DO i = 1, klon         DO i = 1, klon
# Line 1113  contains Line 1067  contains
1067      ! Calculer la derive du flux infrarouge      ! Calculer la derive du flux infrarouge
1068    
1069      DO i = 1, klon      DO i = 1, klon
1070         dlw(i) = - 4.0*RSIGMA*zxtsol(i)**3         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3
1071      ENDDO      ENDDO
1072    
1073      ! Appeler la convection (au choix)      ! Appeler la convection (au choix)
1074    
1075      DO k = 1, llm      DO k = 1, llm
1076         DO i = 1, klon         DO i = 1, klon
1077            conv_q(i, k) = d_q_dyn(i, k) &            conv_q(i, k) = d_q_dyn(i, k) + d_q_vdf(i, k)/dtphys
1078                 + d_q_vdf(i, k)/dtphys            conv_t(i, k) = d_t_dyn(i, k) + d_t_vdf(i, k)/dtphys
           conv_t(i, k) = d_t_dyn(i, k) &  
                + d_t_vdf(i, k)/dtphys  
1079         ENDDO         ENDDO
1080      ENDDO      ENDDO
1081    
1082      IF (check) THEN      IF (check) THEN
1083         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1084         print *, "avantcon = ", za         print *, "avantcon = ", za
1085      ENDIF      ENDIF
     zx_ajustq = iflag_con == 2  
     IF (zx_ajustq) THEN  
        DO i = 1, klon  
           z_avant(i) = 0.0  
        ENDDO  
        DO k = 1, llm  
           DO i = 1, klon  
              z_avant(i) = z_avant(i) + (q_seri(i, k) + ql_seri(i, k)) &  
                   *zmasse(i, k)  
           ENDDO  
        ENDDO  
     ENDIF  
1086    
1087      select case (iflag_con)      if (iflag_con == 2) then
1088      case (2)         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
1089         CALL conflx(dtphys, paprs, play, t_seri, q_seri, conv_t, conv_q, &         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:-1), q_seri, &
1090              zxfluxq(1, 1), omega, d_t_con, d_q_con, rain_con, snow_con, pmfu, &              conv_t, conv_q, zxfluxq(:, 1), omega, d_t_con, d_q_con, &
1091              pmfd, pen_u, pde_u, pen_d, pde_d, kcbot, kctop, kdtop, pmflxr, &              rain_con, snow_con, pmfu, pmfd, pen_u, pde_u, pen_d, &
1092              pmflxs)              pde_d, kcbot, kctop, kdtop, pmflxr, pmflxs)
1093         WHERE (rain_con < 0.) rain_con = 0.         WHERE (rain_con < 0.) rain_con = 0.
1094         WHERE (snow_con < 0.) snow_con = 0.         WHERE (snow_con < 0.) snow_con = 0.
1095         DO i = 1, klon         DO i = 1, klon
1096            ibas_con(i) = llm + 1 - kcbot(i)            ibas_con(i) = llm + 1 - kcbot(i)
1097            itop_con(i) = llm + 1 - kctop(i)            itop_con(i) = llm + 1 - kctop(i)
1098         ENDDO         ENDDO
1099      case (3:)      else
1100         ! number of tracers for the convection scheme of Kerry Emanuel:         ! iflag_con >= 3
1101           CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, &
1102                v_seri, tr_seri, ema_work1, ema_work2, d_t_con, d_q_con, &
1103                d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &
1104                itop_con, upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, &
1105                pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, &
1106                wd, pmflxr, pmflxs, da, phi, mp, ntra=1)
1107           ! (number of tracers for the convection scheme of Kerry Emanuel:
1108         ! la partie traceurs est faite dans phytrac         ! la partie traceurs est faite dans phytrac
1109         ! on met ntra = 1 pour limiter les appels mais on peut         ! on met ntra = 1 pour limiter les appels mais on peut
1110         ! supprimer les calculs / ftra.         ! supprimer les calculs / ftra.)
1111         ntra = 1  
        ! Schéma de convection modularisé et vectorisé :  
        ! (driver commun aux versions 3 et 4)  
   
        CALL concvl(iflag_con, dtphys, paprs, play, t_seri, q_seri, u_seri, &  
             v_seri, tr_seri, ntra, ema_work1, ema_work2, d_t_con, d_q_con, &  
             d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, itop_con, &  
             upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, pbase, bbase, &  
             dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, pmflxs, &  
             da, phi, mp)  
1112         clwcon0 = qcondc         clwcon0 = qcondc
1113         pmfu = upwd + dnwd         pmfu = upwd + dnwd
1114           IF (.NOT. ok_gust) wd = 0.
        IF (.NOT. ok_gust) THEN  
           do i = 1, klon  
              wd(i) = 0.0  
           enddo  
        ENDIF  
1115    
1116         ! Calcul des propriétés des nuages convectifs         ! Calcul des propriétés des nuages convectifs
1117    
# Line 1205  contains Line 1139  contains
1139         clwcon0 = fact_cldcon*clwcon0         clwcon0 = fact_cldcon*clwcon0
1140         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
1141              rnebcon0)              rnebcon0)
1142      case default      END if
        print *, "iflag_con non-prevu", iflag_con  
        stop 1  
     END select  
1143    
1144      DO k = 1, llm      DO k = 1, llm
1145         DO i = 1, klon         DO i = 1, klon
# Line 1242  contains Line 1173  contains
1173         zx_t = zx_t/za*dtphys         zx_t = zx_t/za*dtphys
1174         print *, "Precip = ", zx_t         print *, "Precip = ", zx_t
1175      ENDIF      ENDIF
1176      IF (zx_ajustq) THEN  
1177         DO i = 1, klon      IF (iflag_con == 2) THEN
1178            z_apres(i) = 0.0         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
1179         ENDDO         z_factor = (z_avant - (rain_con + snow_con) * dtphys) / z_apres
        DO k = 1, llm  
           DO i = 1, klon  
              z_apres(i) = z_apres(i) + (q_seri(i, k) + ql_seri(i, k)) &  
                   *zmasse(i, k)  
           ENDDO  
        ENDDO  
        DO i = 1, klon  
           z_factor(i) = (z_avant(i)-(rain_con(i) + snow_con(i))*dtphys) &  
                /z_apres(i)  
        ENDDO  
1180         DO k = 1, llm         DO k = 1, llm
1181            DO i = 1, klon            DO i = 1, klon
1182               IF (z_factor(i) > 1. + 1E-8 .OR. z_factor(i) < 1. - 1E-8) THEN               IF (z_factor(i) > 1. + 1E-8 .OR. z_factor(i) < 1. - 1E-8) THEN
# Line 1264  contains Line 1185  contains
1185            ENDDO            ENDDO
1186         ENDDO         ENDDO
1187      ENDIF      ENDIF
     zx_ajustq = .FALSE.  
1188    
1189      ! Convection sèche (thermiques ou ajustement)      ! Convection sèche (thermiques ou ajustement)
1190    
# Line 1295  contains Line 1215  contains
1215    
1216      ! Caclul des ratqs      ! Caclul des ratqs
1217    
1218      ! ratqs convectifs a l'ancienne en fonction de q(z = 0)-q / q      ! ratqs convectifs à l'ancienne en fonction de (q(z = 0) - q) / q
1219      ! on ecrase le tableau ratqsc calcule par clouds_gno      ! on écrase le tableau ratqsc calculé par clouds_gno
1220      if (iflag_cldcon == 1) then      if (iflag_cldcon == 1) then
1221         do k = 1, llm         do k = 1, llm
1222            do i = 1, klon            do i = 1, klon
1223               if(ptconv(i, k)) then               if(ptconv(i, k)) then
1224                  ratqsc(i, k) = ratqsbas &                  ratqsc(i, k) = ratqsbas + fact_cldcon &
1225                       +fact_cldcon*(q_seri(i, 1)-q_seri(i, k))/q_seri(i, k)                       * (q_seri(i, 1) - q_seri(i, k)) / q_seri(i, k)
1226               else               else
1227                  ratqsc(i, k) = 0.                  ratqsc(i, k) = 0.
1228               endif               endif
# Line 1313  contains Line 1233  contains
1233      ! ratqs stables      ! ratqs stables
1234      do k = 1, llm      do k = 1, llm
1235         do i = 1, klon         do i = 1, klon
1236            ratqss(i, k) = ratqsbas + (ratqshaut-ratqsbas)* &            ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas) &
1237                 min((paprs(i, 1)-play(i, k))/(paprs(i, 1)-30000.), 1.)                 * min((paprs(i, 1) - play(i, k)) / (paprs(i, 1) - 3e4), 1.)
1238         enddo         enddo
1239      enddo      enddo
1240    
1241      ! ratqs final      ! ratqs final
1242      if (iflag_cldcon == 1 .or.iflag_cldcon == 2) then      if (iflag_cldcon == 1 .or. iflag_cldcon == 2) then
1243         ! les ratqs sont une conbinaison de ratqss et ratqsc         ! les ratqs sont une conbinaison de ratqss et ratqsc
1244         ! ratqs final         ! ratqs final
1245         ! 1e4 (en gros 3 heures), en dur pour le moment, est le temps de         ! 1e4 (en gros 3 heures), en dur pour le moment, est le temps de
1246         ! relaxation des ratqs         ! relaxation des ratqs
1247         facteur = exp(-dtphys*facttemps)         ratqs = max(ratqs * exp(- dtphys * facttemps), ratqss)
        ratqs = max(ratqs*facteur, ratqss)  
1248         ratqs = max(ratqs, ratqsc)         ratqs = max(ratqs, ratqsc)
1249      else      else
1250         ! on ne prend que le ratqs stable pour fisrtilp         ! on ne prend que le ratqs stable pour fisrtilp
# Line 1396  contains Line 1315  contains
1315         endif         endif
1316    
1317         ! Nuages diagnostiques pour Tiedtke         ! Nuages diagnostiques pour Tiedtke
1318         CALL diagcld1(paprs, play, &         CALL diagcld1(paprs, play, rain_tiedtke, snow_tiedtke, ibas_con, &
1319              rain_tiedtke, snow_tiedtke, ibas_con, itop_con, &              itop_con, diafra, dialiq)
             diafra, dialiq)  
1320         DO k = 1, llm         DO k = 1, llm
1321            DO i = 1, klon            DO i = 1, klon
1322               IF (diafra(i, k) > cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
# Line 1414  contains Line 1332  contains
1332         facteur = dtphys *facttemps         facteur = dtphys *facttemps
1333         do k = 1, llm         do k = 1, llm
1334            do i = 1, klon            do i = 1, klon
1335               rnebcon(i, k) = rnebcon(i, k)*facteur               rnebcon(i, k) = rnebcon(i, k) * facteur
1336               if (rnebcon0(i, k)*clwcon0(i, k) > rnebcon(i, k)*clwcon(i, k)) &               if (rnebcon0(i, k)*clwcon0(i, k) > rnebcon(i, k)*clwcon(i, k)) &
1337                    then                    then
1338                  rnebcon(i, k) = rnebcon0(i, k)                  rnebcon(i, k) = rnebcon0(i, k)
# Line 1490  contains Line 1408  contains
1408    
1409      ! Paramètres optiques des nuages et quelques paramètres pour diagnostics :      ! Paramètres optiques des nuages et quelques paramètres pour diagnostics :
1410      if (ok_newmicro) then      if (ok_newmicro) then
1411         CALL newmicro(paprs, play, ok_newmicro, t_seri, cldliq, cldfra, &         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &
1412              cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, &              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc, ok_aie, &
1413              fiwc, ok_aie, sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, &              sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, re, fl)
             re, fl)  
1414      else      else
1415         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &
1416              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &
# Line 1689  contains Line 1606  contains
1606    
1607      ! SORTIES      ! SORTIES
1608    
1609      !cc prw = eau precipitable      ! prw = eau precipitable
1610      DO i = 1, klon      DO i = 1, klon
1611         prw(i) = 0.         prw(i) = 0.
1612         DO k = 1, llm         DO k = 1, llm
Legend:
Removed from v.68  
changed lines
  Added in v.70
  ViewVC Help
Powered by ViewVC 1.1.21