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

Diff of /trunk/Sources/phylmd/physiq.f

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

trunk/phylmd/physiq.f revision 99 by guez, Wed Jul 2 18:39:15 2014 UTC trunk/Sources/phylmd/physiq.f revision 154 by guez, Tue Jul 7 17:49:23 2015 UTC
# Line 4  module physiq_m Line 4  module physiq_m
4    
5  contains  contains
6    
7    SUBROUTINE physiq(lafin, rdayvrai, time, dtphys, paprs, play, pphi, pphis, &    SUBROUTINE physiq(lafin, dayvrai, time, paprs, play, pphi, pphis, u, v, t, &
8         u, v, t, qx, omega, d_u, d_v, d_t, d_qx)         qx, omega, d_u, d_v, d_t, d_qx)
9    
10      ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28      ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28
11      ! (subversion revision 678)      ! (subversion revision 678)
12    
13      ! Author: Z.X. Li (LMD/CNRS) 1993      ! Author: Z. X. Li (LMD/CNRS) 1993
14    
15      ! This is the main procedure for the "physics" part of the program.      ! This is the main procedure for the "physics" part of the program.
16    
# Line 22  contains Line 22  contains
22      USE clesphys, ONLY: cdhmax, cdmmax, co2_ppm, ecrit_hf, ecrit_ins, &      USE clesphys, ONLY: cdhmax, cdmmax, co2_ppm, ecrit_hf, ecrit_ins, &
23           ecrit_mth, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin           ecrit_mth, ecrit_reg, ecrit_tra, ksta, ksta_ter, ok_kzmin
24      USE clesphys2, ONLY: cycle_diurne, iflag_con, nbapp_rad, new_oliq, &      USE clesphys2, ONLY: cycle_diurne, iflag_con, nbapp_rad, new_oliq, &
25           ok_orodr, ok_orolf, soil_model           ok_orodr, ok_orolf
26      USE clmain_m, ONLY: clmain      USE clmain_m, ONLY: clmain
27      use clouds_gno_m, only: clouds_gno      use clouds_gno_m, only: clouds_gno
28      USE comgeomphy, ONLY: airephy, cuphy, cvphy      use comconst, only: dtphys
29        USE comgeomphy, ONLY: airephy
30      USE concvl_m, ONLY: concvl      USE concvl_m, ONLY: concvl
31      USE conf_gcm_m, ONLY: offline, raz_date      USE conf_gcm_m, ONLY: offline, raz_date, day_step, iphysiq
32      USE conf_phys_m, ONLY: conf_phys      USE conf_phys_m, ONLY: conf_phys
33      use conflx_m, only: conflx      use conflx_m, only: conflx
34      USE ctherm, ONLY: iflag_thermals, nsplit_thermals      USE ctherm, ONLY: iflag_thermals, nsplit_thermals
# Line 38  contains Line 39  contains
39      USE dimphy, ONLY: klon      USE dimphy, ONLY: klon
40      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
41      use drag_noro_m, only: drag_noro      use drag_noro_m, only: drag_noro
42        use dynetat0_m, only: day_ref, annee_ref
43      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep
44      use fisrtilp_m, only: fisrtilp      use fisrtilp_m, only: fisrtilp
45      USE hgardfou_m, ONLY: hgardfou      USE hgardfou_m, ONLY: hgardfou
# Line 54  contains Line 56  contains
56      USE qcheck_m, ONLY: qcheck      USE qcheck_m, ONLY: qcheck
57      use radlwsw_m, only: radlwsw      use radlwsw_m, only: radlwsw
58      use readsulfate_m, only: readsulfate      use readsulfate_m, only: readsulfate
59        use readsulfate_preind_m, only: readsulfate_preind
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: itau_phy
63      use unit_nml_m, only: unit_nml      use unit_nml_m, only: unit_nml
64      USE ymds2ju_m, ONLY: ymds2ju      USE ymds2ju_m, ONLY: ymds2ju
65      USE yoethf_m, ONLY: r2es, rvtmp2      USE yoethf_m, ONLY: r2es, rvtmp2
# Line 64  contains Line 67  contains
67    
68      logical, intent(in):: lafin ! dernier passage      logical, intent(in):: lafin ! dernier passage
69    
70      REAL, intent(in):: rdayvrai      integer, intent(in):: dayvrai
71      ! (elapsed time since January 1st 0h of the starting year, in days)      ! current day number, based at value 1 on January 1st of annee_ref
72    
73      REAL, intent(in):: time ! heure de la journ\'ee en fraction de jour      REAL, intent(in):: time ! heure de la journ\'ee en fraction de jour
     REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)  
74    
75      REAL, intent(in):: paprs(:, :) ! (klon, llm + 1)      REAL, intent(in):: paprs(:, :) ! (klon, llm + 1)
76      ! pression pour chaque inter-couche, en Pa      ! pression pour chaque inter-couche, en Pa
# Line 222  contains Line 224  contains
224      ! Variables propres a la physique      ! Variables propres a la physique
225    
226      INTEGER, save:: radpas      INTEGER, save:: radpas
227      ! (Radiative transfer computations are made every "radpas" call to      ! Radiative transfer computations are made every "radpas" call to
228      ! "physiq".)      ! "physiq".
229    
230      REAL radsol(klon)      REAL radsol(klon)
231      SAVE radsol ! bilan radiatif au sol calcule par code radiatif      SAVE radsol ! bilan radiatif au sol calcule par code radiatif
# Line 242  contains Line 244  contains
244      REAL, save:: fqsurf(klon, nbsrf)      REAL, save:: fqsurf(klon, nbsrf)
245      ! humidite de l'air au contact de la surface      ! humidite de l'air au contact de la surface
246    
247      REAL, save:: qsol(klon) ! hauteur d'eau dans le sol      REAL, save:: qsol(klon)
248        ! column-density of water in soil, in kg m-2
249    
250      REAL, save:: fsnow(klon, nbsrf) ! epaisseur neigeuse      REAL, save:: fsnow(klon, nbsrf) ! epaisseur neigeuse
251      REAL, save:: falbe(klon, nbsrf) ! albedo par type de surface      REAL, save:: falbe(klon, nbsrf) ! albedo par type de surface
252      REAL, save:: falblw(klon, nbsrf) ! albedo par type de surface      REAL, save:: falblw(klon, nbsrf) ! albedo par type de surface
# Line 302  contains Line 306  contains
306      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)      REAL frac_impa(klon, llm) ! fractions d'aerosols lessivees (impaction)
307      REAL frac_nucl(klon, llm) ! idem (nucleation)      REAL frac_nucl(klon, llm) ! idem (nucleation)
308    
309      REAL, save:: rain_fall(klon) ! pluie      REAL, save:: rain_fall(klon)
310      REAL, save:: snow_fall(klon) ! neige      ! liquid water mass flux (kg/m2/s), positive down
311    
312        REAL, save:: snow_fall(klon)
313        ! solid water mass flux (kg/m2/s), positive down
314    
315      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
316    
# Line 312  contains Line 319  contains
319      REAL dlw(klon) ! derivee infra rouge      REAL dlw(klon) ! derivee infra rouge
320      SAVE dlw      SAVE dlw
321      REAL bils(klon) ! bilan de chaleur au sol      REAL bils(klon) ! bilan de chaleur au sol
322      REAL fder(klon) ! Derive de flux (sensible et latente)      REAL, save:: fder(klon) ! Derive de flux (sensible et latente)
     save fder  
323      REAL ve(klon) ! integr. verticale du transport meri. de l'energie      REAL ve(klon) ! integr. verticale du transport meri. de l'energie
324      REAL vq(klon) ! integr. verticale du transport meri. de l'eau      REAL vq(klon) ! integr. verticale du transport meri. de l'eau
325      REAL ue(klon) ! integr. verticale du transport zonal de l'energie      REAL ue(klon) ! integr. verticale du transport zonal de l'energie
# Line 363  contains Line 369  contains
369      ! Le rayonnement n'est pas calcul\'e tous les pas, il faut donc que      ! Le rayonnement n'est pas calcul\'e tous les pas, il faut donc que
370      ! les variables soient r\'emanentes.      ! les variables soient r\'emanentes.
371      REAL, save:: heat(klon, llm) ! chauffage solaire      REAL, save:: heat(klon, llm) ! chauffage solaire
372      REAL heat0(klon, llm) ! chauffage solaire ciel clair      REAL, save:: heat0(klon, llm) ! chauffage solaire ciel clair
373      REAL, save:: cool(klon, llm) ! refroidissement infrarouge      REAL, save:: cool(klon, llm) ! refroidissement infrarouge
374      REAL cool0(klon, llm) ! refroidissement infrarouge ciel clair      REAL, save:: cool0(klon, llm) ! refroidissement infrarouge ciel clair
375      REAL, save:: topsw(klon), toplw(klon), solsw(klon)      REAL, save:: topsw(klon), toplw(klon), solsw(klon)
376      REAL, save:: sollw(klon) ! rayonnement infrarouge montant \`a la surface      REAL, save:: sollw(klon) ! rayonnement infrarouge montant \`a la surface
377      real, save:: sollwdown(klon) ! downward LW flux at surface      real, save:: sollwdown(klon) ! downward LW flux at surface
378      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      REAL, save:: topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
379      REAL albpla(klon)      REAL, save:: albpla(klon)
380      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface      REAL fsollw(klon, nbsrf) ! bilan flux IR pour chaque sous surface
381      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface      REAL fsolsw(klon, nbsrf) ! flux solaire absorb. pour chaque sous surface
     SAVE albpla  
     SAVE heat0, cool0  
   
     INTEGER itaprad  
     SAVE itaprad  
382    
383      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)      REAL conv_q(klon, llm) ! convergence de l'humidite (kg/kg/s)
384      REAL conv_t(klon, llm) ! convergence of temperature (K/s)      REAL conv_t(klon, llm) ! convergence of temperature (K/s)
# Line 387  contains Line 388  contains
388    
389      REAL zxtsol(klon), zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)      REAL zxtsol(klon), zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)
390    
391      REAL dist, rmu0(klon), fract(klon)      REAL dist, mu0(klon), fract(klon)
392      real zlongi      real longi
393      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
394      REAL za, zb      REAL za, zb
395      REAL zx_t, zx_qs, zdelta, zcor      REAL zx_t, zx_qs, zcor
396      real zqsat(klon, llm)      real zqsat(klon, llm)
397      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
398      REAL, PARAMETER:: t_coup = 234.      REAL, PARAMETER:: t_coup = 234.
# Line 496  contains Line 497  contains
497      REAL ue_lay(klon, llm) ! transport zonal de l'energie a chaque niveau vert.      REAL ue_lay(klon, llm) ! transport zonal de l'energie a chaque niveau vert.
498      REAL uq_lay(klon, llm) ! transport zonal de l'eau a chaque niveau vert.      REAL uq_lay(klon, llm) ! transport zonal de l'eau a chaque niveau vert.
499    
     REAL zsto  
500      real date0      real date0
501    
502      ! Variables li\'ees au bilan d'\'energie et d'enthalpie :      ! Variables li\'ees au bilan d'\'energie et d'enthalpie :
# Line 626  contains Line 626  contains
626    
627         frugs = 0.         frugs = 0.
628         itap = 0         itap = 0
        itaprad = 0  
629         CALL phyetat0(pctsrf, ftsol, ftsoil, tslab, seaice, fqsurf, qsol, &         CALL phyetat0(pctsrf, ftsol, ftsoil, tslab, seaice, fqsurf, qsol, &
630              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollw, &              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollw, &
631              dlw, radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, &              dlw, radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, &
# Line 636  contains Line 635  contains
635         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
636         q2 = 1e-8         q2 = 1e-8
637    
638         radpas = NINT(86400. / dtphys / nbapp_rad)         lmt_pas = day_step / iphysiq
639           print *, 'Number of time steps of "physics" per day: ', lmt_pas
640    
641         ! on remet le calendrier a zero         radpas = lmt_pas / nbapp_rad
642    
643           ! On remet le calendrier a zero
644         IF (raz_date) itau_phy = 0         IF (raz_date) itau_phy = 0
645    
        PRINT *, 'cycle_diurne = ', cycle_diurne  
646         CALL printflag(radpas, ok_journe, ok_instan, ok_region)         CALL printflag(radpas, ok_journe, ok_instan, ok_region)
647    
        IF (dtphys * REAL(radpas) > 21600. .AND. cycle_diurne) THEN  
           print *, "Au minimum 4 appels par jour si cycle diurne"  
           call abort_gcm('physiq', &  
                "Nombre d'appels au rayonnement insuffisant", 1)  
        ENDIF  
   
648         ! Initialisation pour le sch\'ema de convection d'Emanuel :         ! Initialisation pour le sch\'ema de convection d'Emanuel :
649         IF (iflag_con >= 3) THEN         IF (iflag_con >= 3) THEN
650            ibas_con = 1            ibas_con = 1
# Line 663  contains Line 658  contains
658            rugoro = 0.            rugoro = 0.
659         ENDIF         ENDIF
660    
        lmt_pas = NINT(86400. / dtphys) ! tous les jours  
        print *, 'Number of time steps of "physics" per day: ', lmt_pas  
   
661         ecrit_ins = NINT(ecrit_ins/dtphys)         ecrit_ins = NINT(ecrit_ins/dtphys)
662         ecrit_hf = NINT(ecrit_hf/dtphys)         ecrit_hf = NINT(ecrit_hf/dtphys)
663         ecrit_mth = NINT(ecrit_mth/dtphys)         ecrit_mth = NINT(ecrit_mth/dtphys)
# Line 675  contains Line 667  contains
667         ! Initialisation des sorties         ! Initialisation des sorties
668    
669         call ini_histins(dtphys, ok_instan, nid_ins)         call ini_histins(dtphys, ok_instan, nid_ins)
670         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, day_ref, 0., date0)
671         ! Positionner date0 pour initialisation de ORCHIDEE         ! Positionner date0 pour initialisation de ORCHIDEE
672         print *, 'physiq date0: ', date0         print *, 'physiq date0: ', date0
673      ENDIF test_firstcal      ENDIF test_firstcal
# Line 735  contains Line 727  contains
727    
728      ! Incrémenter le compteur de la physique      ! Incrémenter le compteur de la physique
729      itap = itap + 1      itap = itap + 1
730      julien = MOD(NINT(rdayvrai), 360)      julien = MOD(dayvrai, 360)
731      if (julien == 0) julien = 360      if (julien == 0) julien = 360
732    
733      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k) - paprs(:, k + 1)) / rg
734    
735      ! Prescrire l'ozone :      ! Prescrire l'ozone :
736      wo = ozonecm(REAL(julien), paprs)      wo = ozonecm(REAL(julien), paprs)
# Line 765  contains Line 757  contains
757      frugs = MAX(frugs, 0.000015)      frugs = MAX(frugs, 0.000015)
758      zxrugs = sum(frugs * pctsrf, dim = 2)      zxrugs = sum(frugs * pctsrf, dim = 2)
759    
760      ! Calculs nécessaires au calcul de l'albedo dans l'interface      ! Calculs nécessaires au calcul de l'albedo dans l'interface avec
761        ! la surface.
762    
763      CALL orbite(REAL(julien), zlongi, dist)      CALL orbite(REAL(julien), longi, dist)
764      IF (cycle_diurne) THEN      IF (cycle_diurne) THEN
765         CALL zenang(zlongi, time, dtphys * REAL(radpas), rmu0, fract)         CALL zenang(longi, time, dtphys * radpas, mu0, fract)
766      ELSE      ELSE
767         rmu0 = -999.999         mu0 = -999.999
768      ENDIF      ENDIF
769    
770      ! Calcul de l'abedo moyen par maille      ! Calcul de l'abedo moyen par maille
# Line 792  contains Line 785  contains
785      ! Couche limite:      ! Couche limite:
786    
787      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, u_seri, &      CALL clmain(dtphys, itap, pctsrf, pctsrf_new, t_seri, q_seri, u_seri, &
788           v_seri, julien, rmu0, co2_ppm, ftsol, soil_model, &           v_seri, julien, mu0, co2_ppm, ftsol, cdmmax, cdhmax, ksta, ksta_ter, &
789           cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, play, &           ok_kzmin, ftsoil, qsol, paprs, play, fsnow, fqsurf, fevap, falbe, &
790           fsnow, fqsurf, fevap, falbe, falblw, fluxlat, rain_fall, snow_fall, &           falblw, fluxlat, rain_fall, snow_fall, fsolsw, fsollw, fder, rlat, &
791           fsolsw, fsollw, fder, rlat, frugs, firstcal, agesno, rugoro, &           frugs, firstcal, agesno, rugoro, d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, &
792           d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, &           d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, q2, dsens, devap, &
793           fluxv, cdragh, cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, &           ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, pblh, capCL, oliqCL, cteiCL, &
794           u10m, v10m, pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, &           pblT, therm, trmb1, trmb2, trmb3, plcl, fqcalving, ffonte, &
795           trmb3, plcl, fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab, &           run_off_lic_0, fluxo, fluxg, tslab)
          seaice)  
796    
797      ! Incr\'ementation des flux      ! Incr\'ementation des flux
798    
# Line 927  contains Line 919  contains
919         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3
920      ENDDO      ENDDO
921    
     ! Appeler la convection (au choix)  
   
     DO k = 1, llm  
        DO i = 1, klon  
           conv_q(i, k) = d_q_dyn(i, k) + d_q_vdf(i, k) / dtphys  
           conv_t(i, k) = d_t_dyn(i, k) + d_t_vdf(i, k) / dtphys  
        ENDDO  
     ENDDO  
   
922      IF (check) print *, "avantcon = ", qcheck(paprs, q_seri, ql_seri)      IF (check) print *, "avantcon = ", qcheck(paprs, q_seri, ql_seri)
923    
924        ! Appeler la convection (au choix)
925    
926      if (iflag_con == 2) then      if (iflag_con == 2) then
927           conv_q = d_q_dyn + d_q_vdf / dtphys
928           conv_t = d_t_dyn + d_t_vdf / dtphys
929         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
930         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:-1), &         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:-1), &
931              q_seri(:, llm:1:-1), conv_t, conv_q, zxfluxq(:, 1), omega, &              q_seri(:, llm:1:-1), conv_t, conv_q, zxfluxq(:, 1), omega, &
# Line 963  contains Line 950  contains
950         mfu = upwd + dnwd         mfu = upwd + dnwd
951         IF (.NOT. ok_gust) wd = 0.         IF (.NOT. ok_gust) wd = 0.
952    
953         ! Calcul des propri\'et\'es des nuages convectifs         IF (thermcep) THEN
954              zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)
955         DO k = 1, llm            zqsat = zqsat / (1. - retv * zqsat)
956            DO i = 1, klon         ELSE
957               IF (thermcep) THEN            zqsat = merge(qsats(t_seri), qsatl(t_seri), t_seri < t_coup) / play
958                  zdelta = MAX(0., SIGN(1., rtt - t_seri(i, k)))         ENDIF
                 zqsat(i, k) = r2es * FOEEW(t_seri(i, k), zdelta) / play(i, k)  
                 zqsat(i, k) = MIN(0.5, zqsat(i, k))  
                 zqsat(i, k) = zqsat(i, k) / (1.-retv*zqsat(i, k))  
              ELSE  
                 IF (t_seri(i, k) < t_coup) THEN  
                    zqsat(i, k) = qsats(t_seri(i, k))/play(i, k)  
                 ELSE  
                    zqsat(i, k) = qsatl(t_seri(i, k))/play(i, k)  
                 ENDIF  
              ENDIF  
           ENDDO  
        ENDDO  
959    
960         ! calcul des proprietes des nuages convectifs         ! Properties of convective clouds
961         clwcon0 = fact_cldcon * clwcon0         clwcon0 = fact_cldcon * clwcon0
962         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
963              rnebcon0)              rnebcon0)
# Line 1221  contains Line 1196  contains
1196         DO i = 1, klon         DO i = 1, klon
1197            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
1198            IF (thermcep) THEN            IF (thermcep) THEN
1199               zdelta = MAX(0., SIGN(1., rtt-zx_t))               zx_qs = r2es * FOEEW(zx_t, rtt >= zx_t)/play(i, k)
              zx_qs = r2es * FOEEW(zx_t, zdelta)/play(i, k)  
1200               zx_qs = MIN(0.5, zx_qs)               zx_qs = MIN(0.5, zx_qs)
1201               zcor = 1./(1.-retv*zx_qs)               zcor = 1./(1.-retv*zx_qs)
1202               zx_qs = zx_qs*zcor               zx_qs = zx_qs*zcor
# Line 1241  contains Line 1215  contains
1215      ! Introduce the aerosol direct and first indirect radiative forcings:      ! Introduce the aerosol direct and first indirect radiative forcings:
1216      IF (ok_ade .OR. ok_aie) THEN      IF (ok_ade .OR. ok_aie) THEN
1217         ! Get sulfate aerosol distribution :         ! Get sulfate aerosol distribution :
1218         CALL readsulfate(rdayvrai, firstcal, sulfate)         CALL readsulfate(dayvrai, time, firstcal, sulfate)
1219         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)         CALL readsulfate_preind(dayvrai, time, firstcal, sulfate_pi)
1220    
1221         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, &
1222              aerindex)              aerindex)
# Line 1264  contains Line 1238  contains
1238              bl95_b1, cldtaupi, re, fl)              bl95_b1, cldtaupi, re, fl)
1239      endif      endif
1240    
1241      ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.      IF (MOD(itap - 1, radpas) == 0) THEN
1242      IF (MOD(itaprad, radpas) == 0) THEN         ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
1243         DO i = 1, klon         DO i = 1, klon
1244            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &
1245                 + falbe(i, is_lic) * pctsrf(i, is_lic) &                 + falbe(i, is_lic) * pctsrf(i, is_lic) &
# Line 1277  contains Line 1251  contains
1251                 + falblw(i, is_sic) * pctsrf(i, is_sic)                 + falblw(i, is_sic) * pctsrf(i, is_sic)
1252         ENDDO         ENDDO
1253         ! Rayonnement (compatible Arpege-IFS) :         ! Rayonnement (compatible Arpege-IFS) :
1254         CALL radlwsw(dist, rmu0, fract, paprs, play, zxtsol, albsol, &         CALL radlwsw(dist, mu0, fract, paprs, play, zxtsol, albsol, &
1255              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &
1256              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &
1257              sollwdown, topsw0, toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, &              sollwdown, topsw0, toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, &
1258              lwup, swdn0, swdn, swup0, swup, ok_ade, ok_aie, tau_ae, piz_ae, &              lwup, swdn0, swdn, swup0, swup, ok_ade, ok_aie, tau_ae, piz_ae, &
1259              cg_ae, topswad, solswad, cldtaupi, topswai, solswai)              cg_ae, topswad, solswad, cldtaupi, topswai, solswai)
        itaprad = 0  
1260      ENDIF      ENDIF
     itaprad = itaprad + 1  
1261    
1262      ! Ajouter la tendance des rayonnements (tous les pas)      ! Ajouter la tendance des rayonnements (tous les pas)
1263    
# Line 1336  contains Line 1308  contains
1308         ENDDO         ENDDO
1309    
1310         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &
1311              zthe, zpic, zval, igwd, idx, itest, t_seri, u_seri, v_seri, &              zthe, zpic, zval, itest, t_seri, u_seri, v_seri, zulow, zvlow, &
1312              zulow, zvlow, zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)              zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)
1313    
1314         ! ajout des tendances         ! ajout des tendances
1315         DO k = 1, llm         DO k = 1, llm
# Line 1398  contains Line 1370  contains
1370           d_qt, d_ec)           d_qt, d_ec)
1371    
1372      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
1373      call phytrac(itap, lmt_pas, julien, time, firstcal, lafin, dtphys, u, t, &      call phytrac(itap, lmt_pas, julien, time, firstcal, lafin, dtphys, t, &
1374           paprs, play, mfu, mfd, pde_u, pen_d, ycoefh, fm_therm, entr_therm, &           paprs, play, mfu, mfd, pde_u, pen_d, ycoefh, fm_therm, entr_therm, &
1375           yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, pphis, albsol, rhcl, &           yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, pphis, da, phi, mp, &
1376           cldfra, rneb, diafra, cldliq, pmflxr, pmflxs, prfl, psfl, da, phi, &           upwd, dnwd, tr_seri, zmasse)
          mp, upwd, dnwd, tr_seri, zmasse)  
1377    
1378      IF (offline) call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, &      IF (offline) call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, &
1379           pde_u, pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &           pde_u, pen_d, pde_d, fm_therm, entr_therm, ycoefh, yu1, yv1, ftsol, &
# Line 1487  contains Line 1458  contains
1458      ! Si c'est la fin, il faut conserver l'etat de redemarrage      ! Si c'est la fin, il faut conserver l'etat de redemarrage
1459      IF (lafin) THEN      IF (lafin) THEN
1460         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1461         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &         CALL phyredem("restartphy.nc", pctsrf, ftsol, ftsoil, tslab, seaice, &
1462              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &              fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, snow_fall, &
1463              rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, &              solsw, sollw, dlw, radsol, frugs, agesno, zmea, zstd, zsig, zgam, &
1464              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &              zthe, zpic, zval, t_ancien, q_ancien, rnebcon, ratqs, clwcon, &
1465              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)              run_off_lic_0, sig1, w01)
1466      ENDIF      ENDIF
1467    
1468      firstcal = .FALSE.      firstcal = .FALSE.
# Line 1506  contains Line 1477  contains
1477        USE histsync_m, ONLY: histsync        USE histsync_m, ONLY: histsync
1478        USE histwrite_m, ONLY: histwrite        USE histwrite_m, ONLY: histwrite
1479    
1480        real zout        integer i, itau_w ! pas de temps ecriture
       integer itau_w ! pas de temps ecriture  
1481        REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)        REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, llm)
1482    
1483        !--------------------------------------------------        !--------------------------------------------------
# Line 1515  contains Line 1485  contains
1485        IF (ok_instan) THEN        IF (ok_instan) THEN
1486           ! Champs 2D:           ! Champs 2D:
1487    
          zsto = dtphys * ecrit_ins  
          zout = dtphys * ecrit_ins  
1488           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1489    
          i = NINT(zout/zsto)  
1490           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, pphis, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, pphis, zx_tmp_2d)
1491           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)
1492    
          i = NINT(zout/zsto)  
1493           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, airephy, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, jjm + 1, airephy, zx_tmp_2d)
1494           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)
1495    
Legend:
Removed from v.99  
changed lines
  Added in v.154
  ViewVC Help
Powered by ViewVC 1.1.21