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

Diff of /trunk/phylmd/physiq.f

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

revision 62 by guez, Thu Jul 26 14:37:37 2012 UTC revision 69 by guez, Mon Feb 18 16:33:12 2013 UTC
# Line 14  contains Line 14  contains
14    
15      use aaam_bud_m, only: aaam_bud      use aaam_bud_m, only: aaam_bud
16      USE abort_gcm_m, ONLY: abort_gcm      USE abort_gcm_m, ONLY: abort_gcm
17        use aeropt_m, only: aeropt
18      use ajsec_m, only: ajsec      use ajsec_m, only: ajsec
19      USE calendar, ONLY: ymds2ju      USE calendar, ONLY: ymds2ju
20      use calltherm_m, only: calltherm      use calltherm_m, only: calltherm
# Line 36  contains Line 37  contains
37      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
38      use drag_noro_m, only: drag_noro      use drag_noro_m, only: drag_noro
39      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep
40        use fisrtilp_m, only: fisrtilp
41      USE hgardfou_m, ONLY: hgardfou      USE hgardfou_m, ONLY: hgardfou
42      USE histsync_m, ONLY: histsync      USE histsync_m, ONLY: histsync
43      USE histwrite_m, ONLY: histwrite      USE histwrite_m, ONLY: histwrite
# Line 44  contains Line 46  contains
46      USE ini_histhf_m, ONLY: ini_histhf      USE ini_histhf_m, ONLY: ini_histhf
47      USE ini_histday_m, ONLY: ini_histday      USE ini_histday_m, ONLY: ini_histday
48      USE ini_histins_m, ONLY: ini_histins      USE ini_histins_m, ONLY: ini_histins
49        use newmicro_m, only: newmicro
50      USE oasis_m, ONLY: ok_oasis      USE oasis_m, ONLY: ok_oasis
51      USE orbite_m, ONLY: orbite, zenang      USE orbite_m, ONLY: orbite, zenang
52      USE ozonecm_m, ONLY: ozonecm      USE ozonecm_m, ONLY: ozonecm
# Line 53  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
63        use unit_nml_m, only: unit_nml
64      USE yoethf_m, ONLY: r2es, rvtmp2      USE yoethf_m, ONLY: r2es, rvtmp2
65    
66      ! Arguments:      ! Arguments:
# Line 116  contains Line 121  contains
121      logical rnpb      logical rnpb
122      parameter(rnpb = .true.)      parameter(rnpb = .true.)
123    
124      character(len = 6), save:: ocean      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 129  contains Line 131  contains
131      REAL fluxg(klon) ! flux turbulents ocean-atmosphere      REAL fluxg(klon) ! flux turbulents ocean-atmosphere
132    
133      ! Modele thermique du sol, a activer pour le cycle diurne:      ! Modele thermique du sol, a activer pour le cycle diurne:
134      logical, save:: ok_veget      logical:: ok_veget = .false. ! type de modele de vegetation utilise
     LOGICAL, save:: ok_journe ! sortir le fichier journalier  
   
     LOGICAL ok_mensuel ! sortir le fichier mensuel  
135    
136      LOGICAL ok_instan ! sortir le fichier instantane      logical:: ok_journe = .false., ok_mensuel = .true., ok_instan = .false.
137      save ok_instan      ! sorties journalieres, mensuelles et instantanees dans les
138        ! fichiers histday, histmth et histins
139    
140      LOGICAL ok_region ! sortir le fichier regional      LOGICAL ok_region ! sortir le fichier regional
141      PARAMETER (ok_region = .FALSE.)      PARAMETER (ok_region = .FALSE.)
# Line 318  contains Line 318  contains
318      SAVE qcondc      SAVE qcondc
319      REAL ema_work1(klon, llm), ema_work2(klon, llm)      REAL ema_work1(klon, llm), ema_work2(klon, llm)
320      SAVE ema_work1, ema_work2      SAVE ema_work1, ema_work2
321        REAL, save:: wd(klon)
     REAL wd(klon) ! sb  
     SAVE wd ! sb  
322    
323      ! Variables locales pour la couche limite (al1):      ! Variables locales pour la couche limite (al1):
324    
# Line 329  contains Line 327  contains
327      REAL cdragh(klon) ! drag coefficient pour T and Q      REAL cdragh(klon) ! drag coefficient pour T and Q
328      REAL cdragm(klon) ! drag coefficient pour vent      REAL cdragm(klon) ! drag coefficient pour vent
329    
330      !AA Pour phytrac      ! Pour phytrac :
331      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac      REAL ycoefh(klon, llm) ! coef d'echange pour phytrac
332      REAL yu1(klon) ! vents dans la premiere couche U      REAL yu1(klon) ! vents dans la premiere couche U
333      REAL yv1(klon) ! vents dans la premiere couche V      REAL yv1(klon) ! vents dans la premiere couche V
# Line 391  contains Line 389  contains
389      EXTERNAL alboc ! calculer l'albedo sur ocean      EXTERNAL alboc ! calculer l'albedo sur ocean
390      !KE43      !KE43
391      EXTERNAL conema3 ! convect4.3      EXTERNAL conema3 ! convect4.3
     EXTERNAL fisrtilp ! schema de condensation a grande echelle (pluie)  
392      EXTERNAL nuage ! calculer les proprietes radiatives      EXTERNAL nuage ! calculer les proprietes radiatives
393      EXTERNAL transp ! transport total de l'eau et de l'energie      EXTERNAL transp ! transport total de l'eau et de l'energie
394    
# Line 449  contains Line 446  contains
446      REAL dist, rmu0(klon), fract(klon)      REAL dist, rmu0(klon), fract(klon)
447      REAL zdtime ! pas de temps du rayonnement (s)      REAL zdtime ! pas de temps du rayonnement (s)
448      real zlongi      real zlongi
   
449      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
     LOGICAL zx_ajustq  
   
450      REAL za, zb      REAL za, zb
451      REAL zx_t, zx_qs, zdelta, zcor      REAL zx_t, zx_qs, zdelta, zcor
452      real zqsat(klon, llm)      real zqsat(klon, llm)
453      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
454      REAL t_coup      REAL, PARAMETER:: t_coup = 234.
     PARAMETER (t_coup = 234.0)  
   
455      REAL zphi(klon, llm)      REAL zphi(klon, llm)
456    
457      !IM cf. AM Variables locales pour la CLA (hbtm2)      !IM cf. AM Variables locales pour la CLA (hbtm2)
# Line 496  contains Line 488  contains
488      REAL rflag(klon) ! flag fonctionnement de convect      REAL rflag(klon) ! flag fonctionnement de convect
489      INTEGER iflagctrl(klon) ! flag fonctionnement de convect      INTEGER iflagctrl(klon) ! flag fonctionnement de convect
490      ! -- convect43:      ! -- convect43:
     INTEGER ntra ! nb traceurs pour convect4.3  
491      REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)      REAL dtvpdt1(klon, llm), dtvpdq1(klon, llm)
492      REAL dplcldt(klon), dplcldr(klon)      REAL dplcldt(klon), dplcldr(klon)
493    
# Line 535  contains Line 526  contains
526      REAL d_u_lif(klon, llm), d_v_lif(klon, llm)      REAL d_u_lif(klon, llm), d_v_lif(klon, llm)
527      REAL d_t_lif(klon, llm)      REAL d_t_lif(klon, llm)
528    
529      REAL ratqs(klon, llm), ratqss(klon, llm), ratqsc(klon, llm)      REAL, save:: ratqs(klon, llm)
530      real ratqsbas, ratqshaut      real ratqss(klon, llm), ratqsc(klon, llm)
531      save ratqsbas, ratqshaut, ratqs      real:: ratqsbas = 0.01, ratqshaut = 0.3
532    
533      ! Parametres lies au nouveau schema de nuages (SB, PDF)      ! Parametres lies au nouveau schema de nuages (SB, PDF)
534      real, save:: fact_cldcon      real:: fact_cldcon = 0.375
535      real, save:: facttemps      real:: facttemps = 1.e-4
536      logical ok_newmicro      logical:: ok_newmicro = .true.
     save ok_newmicro  
537      real facteur      real facteur
538    
539      integer iflag_cldcon      integer:: iflag_cldcon = 1
     save iflag_cldcon  
   
540      logical ptconv(klon, llm)      logical ptconv(klon, llm)
541    
542      ! Variables locales pour effectuer les appels en série :      ! Variables locales pour effectuer les appels en série :
# Line 581  contains Line 569  contains
569    
570      REAL zsto      REAL zsto
571    
     character(len = 20) modname  
     character(len = 80) abort_message  
572      logical ok_sync      logical ok_sync
573      real date0      real date0
574    
# Line 594  contains Line 580  contains
580      REAL zero_v(klon)      REAL zero_v(klon)
581      CHARACTER(LEN = 15) tit      CHARACTER(LEN = 15) tit
582      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics
583      INTEGER, SAVE:: if_ebil ! level for energy conservation diagnostics      INTEGER:: if_ebil = 0 ! verbosity for diagnostics of energy conservation
584    
585      REAL d_t_ec(klon, llm) ! tendance due à la conversion Ec -> E thermique      REAL d_t_ec(klon, llm) ! tendance due à la conversion Ec -> E thermique
586      REAL ZRCPD      REAL ZRCPD
587    
588      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
589      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) !vents a 10m      REAL u10m(klon, nbsrf), v10m(klon, nbsrf) ! vents a 10 m
590      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
591      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
592      !jq Aerosol effects (Johannes Quaas, 27/11/2003)  
593      REAL sulfate(klon, llm) ! SO4 aerosol concentration [ug/m3]      ! Aerosol effects:
594    
595        REAL sulfate(klon, llm) ! SO4 aerosol concentration (micro g/m3)
596    
597      REAL, save:: sulfate_pi(klon, llm)      REAL, save:: sulfate_pi(klon, llm)
598      ! (SO4 aerosol concentration, in ug/m3, pre-industrial value)      ! SO4 aerosol concentration, in micro g/m3, pre-industrial value
599    
600      REAL cldtaupi(klon, llm)      REAL cldtaupi(klon, llm)
601      ! (Cloud optical thickness for pre-industrial (pi) aerosols)      ! cloud optical thickness for pre-industrial (pi) aerosols
602    
603      REAL re(klon, llm) ! Cloud droplet effective radius      REAL re(klon, llm) ! Cloud droplet effective radius
604      REAL fl(klon, llm) ! denominator of re      REAL fl(klon, llm) ! denominator of re
605    
606      ! Aerosol optical properties      ! Aerosol optical properties
607      REAL tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)      REAL, save:: tau_ae(klon, llm, 2), piz_ae(klon, llm, 2)
608      REAL cg_ae(klon, llm, 2)      REAL, save:: cg_ae(klon, llm, 2)
   
     REAL topswad(klon), solswad(klon) ! Aerosol direct effect.  
     ! ok_ade = True -ADE = topswad-topsw  
609    
610        REAL topswad(klon), solswad(klon) ! aerosol direct effect
611      REAL topswai(klon), solswai(klon) ! aerosol indirect effect      REAL topswai(klon), solswai(klon) ! aerosol indirect effect
     ! ok_aie = True ->  
     ! ok_ade = True -AIE = topswai-topswad  
     ! ok_ade = F -AIE = topswai-topsw  
612    
613      REAL aerindex(klon) ! POLDER aerosol index      REAL aerindex(klon) ! POLDER aerosol index
614    
615      ! Parameters      LOGICAL:: ok_ade = .false. ! apply aerosol direct effect
616      LOGICAL, save:: ok_ade ! apply aerosol direct effect      LOGICAL:: ok_aie = .false. ! apply aerosol indirect effect
617      LOGICAL, save:: ok_aie ! Apply aerosol indirect effect  
618      REAL bl95_b0, bl95_b1 ! Parameter in Boucher and Lohmann (1995)      REAL:: bl95_b0 = 2., bl95_b1 = 0.2
619        ! Parameters in equation (D) of Boucher and Lohmann (1995, Tellus
620        ! B). They link cloud droplet number concentration to aerosol mass
621        ! concentration.
622    
     SAVE bl95_b0, bl95_b1  
623      SAVE u10m      SAVE u10m
624      SAVE v10m      SAVE v10m
625      SAVE t2m      SAVE t2m
626      SAVE q2m      SAVE q2m
627      SAVE ffonte      SAVE ffonte
628      SAVE fqcalving      SAVE fqcalving
     SAVE piz_ae  
     SAVE tau_ae  
     SAVE cg_ae  
629      SAVE rain_con      SAVE rain_con
630      SAVE snow_con      SAVE snow_con
631      SAVE topswai      SAVE topswai
# Line 660  contains Line 642  contains
642    
643      real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2      real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
644    
645        namelist /physiq_nml/ ocean, ok_veget, ok_journe, ok_mensuel, ok_instan, &
646             fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, ratqsbas, &
647             ratqshaut, if_ebil, ok_ade, ok_aie, bl95_b0, bl95_b1, iflag_thermals, &
648             nsplit_thermals
649    
650      !----------------------------------------------------------------      !----------------------------------------------------------------
651    
652      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  
653      ok_sync = .TRUE.      ok_sync = .TRUE.
654      IF (nqmx < 2) THEN      IF (nqmx < 2) CALL abort_gcm('physiq', &
655         abort_message = 'eaux vapeur et liquide sont indispensables'           'eaux vapeur et liquide sont indispensables', 1)
        CALL abort_gcm(modname, abort_message, 1)  
     ENDIF  
656    
657      test_firstcal: IF (firstcal) THEN      test_firstcal: IF (firstcal) THEN
658         ! initialiser         ! initialiser
# Line 687  contains Line 667  contains
667         cg_ae = 0.         cg_ae = 0.
668         rain_con(:) = 0.         rain_con(:) = 0.
669         snow_con(:) = 0.         snow_con(:) = 0.
        bl95_b0 = 0.  
        bl95_b1 = 0.  
670         topswai(:) = 0.         topswai(:) = 0.
671         topswad(:) = 0.         topswad(:) = 0.
672         solswai(:) = 0.         solswai(:) = 0.
# Line 714  contains Line 692  contains
692    
693         IF (if_ebil >= 1) d_h_vcol_phy = 0.         IF (if_ebil >= 1) d_h_vcol_phy = 0.
694    
695         ! Appel à la lecture du run.def physique         iflag_thermals = 0
696         call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, ok_instan, &         nsplit_thermals = 1
697              fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, ratqsbas, &         print *, "Enter namelist 'physiq_nml'."
698              ratqshaut, if_ebil, ok_ade, ok_aie, bl95_b0, bl95_b1, &         read(unit=*, nml=physiq_nml)
699              iflag_thermals, nsplit_thermals)         write(unit_nml, nml=physiq_nml)
700    
701           call conf_phys
702    
703         ! Initialiser les compteurs:         ! Initialiser les compteurs:
704    
# Line 732  contains Line 712  contains
712              ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0)              ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0)
713    
714         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
715         q2 = 1.e-8         q2 = 1e-8
716    
717         radpas = NINT(86400. / dtphys / nbapp_rad)         radpas = NINT(86400. / dtphys / nbapp_rad)
718    
# Line 740  contains Line 720  contains
720         IF (raz_date) itau_phy = 0         IF (raz_date) itau_phy = 0
721    
722         PRINT *, 'cycle_diurne = ', cycle_diurne         PRINT *, 'cycle_diurne = ', cycle_diurne
723           CALL printflag(radpas, ocean /= 'force', ok_oasis, ok_journe, &
724                ok_instan, ok_region)
725    
726         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'  
727            print *, "Au minimum 4 appels par jour si cycle diurne"            print *, "Au minimum 4 appels par jour si cycle diurne"
728            abort_message = 'Nbre d appels au rayonnement insuffisant'            call abort_gcm('physiq', &
729            call abort_gcm(modname, abort_message, 1)                 "Nombre d'appels au rayonnement insuffisant", 1)
730         ENDIF         ENDIF
        print *, "Clef pour la convection, iflag_con = ", iflag_con  
731    
732         ! Initialisation pour la convection de K.E. (sb):         ! Initialisation pour le schéma de convection d'Emanuel :
733         IF (iflag_con >= 3) THEN         IF (iflag_con >= 3) THEN
734            print *, "Convection de Kerry Emanuel 4.3"            ibas_con = 1
735              itop_con = 1
           DO i = 1, klon  
              ibas_con(i) = 1  
              itop_con(i) = 1  
           ENDDO  
736         ENDIF         ENDIF
737    
738         IF (ok_orodr) THEN         IF (ok_orodr) THEN
# Line 793  contains Line 762  contains
762         call ini_histday(dtphys, ok_journe, nid_day, nqmx)         call ini_histday(dtphys, ok_journe, nid_day, nqmx)
763         call ini_histins(dtphys, ok_instan, nid_ins)         call ini_histins(dtphys, ok_instan, nid_ins)
764         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
765         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         ! Positionner date0 pour initialisation de ORCHIDEE
766         WRITE(*, *) 'physiq date0: ', date0         print *, 'physiq date0: ', date0
767      ENDIF test_firstcal      ENDIF test_firstcal
768    
769      ! Mettre a zero des variables de sortie (pour securite)      ! Mettre a zero des variables de sortie (pour securite)
770    
771      DO i = 1, klon      DO i = 1, klon
772         d_ps(i) = 0.0         d_ps(i) = 0.
773      ENDDO      ENDDO
774      DO iq = 1, nqmx      DO iq = 1, nqmx
775         DO k = 1, llm         DO k = 1, llm
776            DO i = 1, klon            DO i = 1, klon
777               d_qx(i, k, iq) = 0.0               d_qx(i, k, iq) = 0.
778            ENDDO            ENDDO
779         ENDDO         ENDDO
780      ENDDO      ENDDO
# Line 890  contains Line 859  contains
859    
860      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg
861    
862      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! Mettre en action les conditions aux limites (albedo, sst etc.).
863    
864      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.      ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
865      wo = ozonecm(REAL(julien), paprs)      wo = ozonecm(REAL(julien), paprs)
# Line 959  contains Line 928  contains
928      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
929         DO i = 1, klon         DO i = 1, klon
930            fsollw(i, nsrf) = sollw(i) &            fsollw(i, nsrf) = sollw(i) &
931                 + 4.0*RSIGMA*ztsol(i)**3 * (ztsol(i)-ftsol(i, nsrf))                 + 4. * RSIGMA * ztsol(i)**3 * (ztsol(i) - ftsol(i, nsrf))
932            fsolsw(i, nsrf) = solsw(i)*(1.-falbe(i, nsrf))/(1.-albsol(i))            fsolsw(i, nsrf) = solsw(i) * (1. - falbe(i, nsrf)) / (1. - albsol(i))
933         ENDDO         ENDDO
934      ENDDO      ENDDO
935    
# Line 1001  contains Line 970  contains
970      END DO      END DO
971      DO i = 1, klon      DO i = 1, klon
972         sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol         sens(i) = - zxfluxt(i, 1) ! flux de chaleur sensible au sol
973         evap(i) = - zxfluxq(i, 1) ! flux d'evaporation au sol         evap(i) = - zxfluxq(i, 1) ! flux d'évaporation au sol
974         fder(i) = dlw(i) + dsens(i) + devap(i)         fder(i) = dlw(i) + dsens(i) + devap(i)
975      ENDDO      ENDDO
976    
# Line 1048  contains Line 1017  contains
1017         s_trmb2(i) = 0.0         s_trmb2(i) = 0.0
1018         s_trmb3(i) = 0.0         s_trmb3(i) = 0.0
1019    
1020         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + &         IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) + pctsrf(i, is_oce) &
1021              pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.)  >  EPSFRA) &              + pctsrf(i, is_sic) - 1.)  >  EPSFRA) print *, &
1022              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  
1023      ENDDO      ENDDO
1024      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1025         DO i = 1, klon         DO i = 1, klon
# Line 1110  contains Line 1076  contains
1076      ! Calculer la derive du flux infrarouge      ! Calculer la derive du flux infrarouge
1077    
1078      DO i = 1, klon      DO i = 1, klon
1079         dlw(i) = - 4.0*RSIGMA*zxtsol(i)**3         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3
1080      ENDDO      ENDDO
1081    
1082      ! Appeler la convection (au choix)      ! Appeler la convection (au choix)
1083    
1084      DO k = 1, llm      DO k = 1, llm
1085         DO i = 1, klon         DO i = 1, klon
1086            conv_q(i, k) = d_q_dyn(i, k) &            conv_q(i, k) = d_q_dyn(i, k) + d_q_vdf(i, k)/dtphys
1087                 + 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  
1088         ENDDO         ENDDO
1089      ENDDO      ENDDO
1090    
1091      IF (check) THEN      IF (check) THEN
1092         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1093         print *, "avantcon = ", za         print *, "avantcon = ", za
1094      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  
1095    
1096      select case (iflag_con)      if (iflag_con == 2) then
1097      case (2)         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
1098         CALL conflx(dtphys, paprs, play, t_seri, q_seri, conv_t, conv_q, &         CALL conflx(dtphys, paprs, play, t_seri, q_seri, conv_t, conv_q, &
1099              zxfluxq(1, 1), omega, d_t_con, d_q_con, rain_con, snow_con, pmfu, &              zxfluxq(1, 1), omega, d_t_con, d_q_con, rain_con, snow_con, pmfu, &
1100              pmfd, pen_u, pde_u, pen_d, pde_d, kcbot, kctop, kdtop, pmflxr, &              pmfd, pen_u, pde_u, pen_d, pde_d, kcbot, kctop, kdtop, pmflxr, &
# Line 1152  contains Line 1105  contains
1105            ibas_con(i) = llm + 1 - kcbot(i)            ibas_con(i) = llm + 1 - kcbot(i)
1106            itop_con(i) = llm + 1 - kctop(i)            itop_con(i) = llm + 1 - kctop(i)
1107         ENDDO         ENDDO
1108      case (3:)      else
1109         ! number of tracers for the convection scheme of Kerry Emanuel:         ! iflag_con >= 3
1110           CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, &
1111                v_seri, tr_seri, ema_work1, ema_work2, d_t_con, d_q_con, &
1112                d_u_con, d_v_con, d_tr, rain_con, snow_con, ibas_con, &
1113                itop_con, upwd, dnwd, dnwd0, Ma, cape, tvp, iflagctrl, &
1114                pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, &
1115                wd, pmflxr, pmflxs, da, phi, mp, ntra=1)
1116           ! (number of tracers for the convection scheme of Kerry Emanuel:
1117         ! la partie traceurs est faite dans phytrac         ! la partie traceurs est faite dans phytrac
1118         ! on met ntra = 1 pour limiter les appels mais on peut         ! on met ntra = 1 pour limiter les appels mais on peut
1119         ! supprimer les calculs / ftra.         ! supprimer les calculs / ftra.)
1120         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)  
1121         clwcon0 = qcondc         clwcon0 = qcondc
1122         pmfu = upwd + dnwd         pmfu = upwd + dnwd
1123           IF (.NOT. ok_gust) wd = 0.
        IF (.NOT. ok_gust) THEN  
           do i = 1, klon  
              wd(i) = 0.0  
           enddo  
        ENDIF  
1124    
1125         ! Calcul des propriétés des nuages convectifs         ! Calcul des propriétés des nuages convectifs
1126    
# Line 1202  contains Line 1148  contains
1148         clwcon0 = fact_cldcon*clwcon0         clwcon0 = fact_cldcon*clwcon0
1149         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
1150              rnebcon0)              rnebcon0)
1151      case default      END if
        print *, "iflag_con non-prevu", iflag_con  
        stop 1  
     END select  
1152    
1153      DO k = 1, llm      DO k = 1, llm
1154         DO i = 1, klon         DO i = 1, klon
# Line 1239  contains Line 1182  contains
1182         zx_t = zx_t/za*dtphys         zx_t = zx_t/za*dtphys
1183         print *, "Precip = ", zx_t         print *, "Precip = ", zx_t
1184      ENDIF      ENDIF
1185      IF (zx_ajustq) THEN  
1186         DO i = 1, klon      IF (iflag_con == 2) THEN
1187            z_apres(i) = 0.0         z_apres = sum((q_seri + ql_seri) * zmasse, dim=2)
1188         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  
1189         DO k = 1, llm         DO k = 1, llm
1190            DO i = 1, klon            DO i = 1, klon
1191               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 1261  contains Line 1194  contains
1194            ENDDO            ENDDO
1195         ENDDO         ENDDO
1196      ENDIF      ENDIF
     zx_ajustq = .FALSE.  
1197    
1198      ! Convection sèche (thermiques ou ajustement)      ! Convection sèche (thermiques ou ajustement)
1199    
# Line 1316  contains Line 1248  contains
1248      enddo      enddo
1249    
1250      ! ratqs final      ! ratqs final
1251      if (iflag_cldcon == 1 .or.iflag_cldcon == 2) then      if (iflag_cldcon == 1 .or. iflag_cldcon == 2) then
1252         ! les ratqs sont une conbinaison de ratqss et ratqsc         ! les ratqs sont une conbinaison de ratqss et ratqsc
1253         ! ratqs final         ! ratqs final
1254         ! 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
# Line 1393  contains Line 1325  contains
1325         endif         endif
1326    
1327         ! Nuages diagnostiques pour Tiedtke         ! Nuages diagnostiques pour Tiedtke
1328         CALL diagcld1(paprs, play, &         CALL diagcld1(paprs, play, rain_tiedtke, snow_tiedtke, ibas_con, &
1329              rain_tiedtke, snow_tiedtke, ibas_con, itop_con, &              itop_con, diafra, dialiq)
             diafra, dialiq)  
1330         DO k = 1, llm         DO k = 1, llm
1331            DO i = 1, klon            DO i = 1, klon
1332               IF (diafra(i, k) > cldfra(i, k)) THEN               IF (diafra(i, k) > cldfra(i, k)) THEN
# Line 1472  contains Line 1403  contains
1403      ENDDO      ENDDO
1404    
1405      ! Introduce the aerosol direct and first indirect radiative forcings:      ! Introduce the aerosol direct and first indirect radiative forcings:
     ! Johannes Quaas, 27/11/2003  
1406      IF (ok_ade .OR. ok_aie) THEN      IF (ok_ade .OR. ok_aie) THEN
1407         ! Get sulfate aerosol distribution         ! Get sulfate aerosol distribution :
1408         CALL readsulfate(rdayvrai, firstcal, sulfate)         CALL readsulfate(rdayvrai, firstcal, sulfate)
1409         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)
1410    
        ! Calculate aerosol optical properties (Olivier Boucher)  
1411         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, tau_ae, piz_ae, cg_ae, &         CALL aeropt(play, paprs, t_seri, sulfate, rhcl, tau_ae, piz_ae, cg_ae, &
1412              aerindex)              aerindex)
1413      ELSE      ELSE
# Line 1489  contains Line 1418  contains
1418    
1419      ! Paramètres optiques des nuages et quelques paramètres pour diagnostics :      ! Paramètres optiques des nuages et quelques paramètres pour diagnostics :
1420      if (ok_newmicro) then      if (ok_newmicro) then
1421         CALL newmicro(paprs, play, ok_newmicro, t_seri, cldliq, cldfra, &         CALL newmicro(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, &
1422              cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, &              cldh, cldl, cldm, cldt, cldq, flwp, fiwp, flwc, fiwc, ok_aie, &
1423              fiwc, ok_aie, sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, &              sulfate, sulfate_pi, bl95_b0, bl95_b1, cldtaupi, re, fl)
             re, fl)  
1424      else      else
1425         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &         CALL nuage(paprs, play, t_seri, cldliq, cldfra, cldtau, cldemi, cldh, &
1426              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &              cldl, cldm, cldt, cldq, ok_aie, sulfate, sulfate_pi, bl95_b0, &
# Line 1688  contains Line 1616  contains
1616    
1617      ! SORTIES      ! SORTIES
1618    
1619      !cc prw = eau precipitable      ! prw = eau precipitable
1620      DO i = 1, klon      DO i = 1, klon
1621         prw(i) = 0.         prw(i) = 0.
1622         DO k = 1, llm         DO k = 1, llm
Legend:
Removed from v.62  
changed lines
  Added in v.69
  ViewVC Help
Powered by ViewVC 1.1.21