/[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 98 by guez, Tue May 13 17:23:16 2014 UTC trunk/Sources/phylmd/physiq.f revision 151 by guez, Tue Jun 23 15:14:20 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, dtphys, paprs, play, pphi, pphis, &
8         u, v, t, qx, omega, d_u, d_v, d_t, d_qx)         u, v, t, 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
# 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 comgeomphy, ONLY: airephy
29      USE concvl_m, ONLY: concvl      USE concvl_m, ONLY: concvl
30      USE conf_gcm_m, ONLY: offline, raz_date      USE conf_gcm_m, ONLY: offline, raz_date
31      USE conf_phys_m, ONLY: conf_phys      USE conf_phys_m, ONLY: conf_phys
# Line 38  contains Line 38  contains
38      USE dimphy, ONLY: klon      USE dimphy, ONLY: klon
39      USE dimsoil, ONLY: nsoilmx      USE dimsoil, ONLY: nsoilmx
40      use drag_noro_m, only: drag_noro      use drag_noro_m, only: drag_noro
41        use dynetat0_m, only: day_ref, annee_ref
42      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep      USE fcttre, ONLY: foeew, qsatl, qsats, thermcep
43      use fisrtilp_m, only: fisrtilp      use fisrtilp_m, only: fisrtilp
44      USE hgardfou_m, ONLY: hgardfou      USE hgardfou_m, ONLY: hgardfou
# Line 54  contains Line 55  contains
55      USE qcheck_m, ONLY: qcheck      USE qcheck_m, ONLY: qcheck
56      use radlwsw_m, only: radlwsw      use radlwsw_m, only: radlwsw
57      use readsulfate_m, only: readsulfate      use readsulfate_m, only: readsulfate
58        use readsulfate_preind_m, only: readsulfate_preind
59      use sugwd_m, only: sugwd      use sugwd_m, only: sugwd
60      USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt      USE suphec_m, ONLY: ra, rcpd, retv, rg, rlvtt, romega, rsigma, rtt
61      USE temps, ONLY: annee_ref, day_ref, itau_phy      USE temps, ONLY: itau_phy
62      use unit_nml_m, only: unit_nml      use unit_nml_m, only: unit_nml
63      USE ymds2ju_m, ONLY: ymds2ju      USE ymds2ju_m, ONLY: ymds2ju
64      USE yoethf_m, ONLY: r2es, rvtmp2      USE yoethf_m, ONLY: r2es, rvtmp2
# Line 64  contains Line 66  contains
66    
67      logical, intent(in):: lafin ! dernier passage      logical, intent(in):: lafin ! dernier passage
68    
69      REAL, intent(in):: rdayvrai      integer, intent(in):: dayvrai
70      ! (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
71    
72      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
73      REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)      REAL, intent(in):: dtphys ! pas d'integration pour la physique (seconde)
# Line 111  contains Line 113  contains
113      LOGICAL, PARAMETER:: ok_stratus = .FALSE.      LOGICAL, PARAMETER:: ok_stratus = .FALSE.
114      ! Ajouter artificiellement les stratus      ! Ajouter artificiellement les stratus
115    
     character(len = 6):: ocean = 'force '  
     ! (type de mod\`ele oc\'ean \`a utiliser: "force" ou "slab" mais  
     ! pas "couple")  
   
116      ! "slab" ocean      ! "slab" ocean
117      REAL, save:: tslab(klon) ! temperature of ocean slab      REAL, save:: tslab(klon) ! temperature of ocean slab
118      REAL, save:: seaice(klon) ! glace de mer (kg/m2)      REAL, save:: seaice(klon) ! glace de mer (kg/m2)
119      REAL fluxo(klon) ! flux turbulents ocean-glace de mer      REAL fluxo(klon) ! flux turbulents ocean-glace de mer
120      REAL fluxg(klon) ! flux turbulents ocean-atmosphere      REAL fluxg(klon) ! flux turbulents ocean-atmosphere
121    
     ! Modele thermique du sol, a activer pour le cycle diurne:  
     logical:: ok_veget = .false. ! type de modele de vegetation utilise  
   
122      logical:: ok_journe = .false., ok_mensuel = .true., ok_instan = .false.      logical:: ok_journe = .false., ok_mensuel = .true., ok_instan = .false.
123      ! sorties journalieres, mensuelles et instantanees dans les      ! sorties journalieres, mensuelles et instantanees dans les
124      ! fichiers histday, histmth et histins      ! fichiers histday, histmth et histins
# Line 229  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 249  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 309  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 394  contains Line 394  contains
394    
395      REAL zxtsol(klon), zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)      REAL zxtsol(klon), zxqsurf(klon), zxsnow(klon), zxfluxlat(klon)
396    
397      REAL dist, rmu0(klon), fract(klon)      REAL dist, mu0(klon), fract(klon)
398      real zlongi      real longi
399      REAL z_avant(klon), z_apres(klon), z_factor(klon)      REAL z_avant(klon), z_apres(klon), z_factor(klon)
400      REAL za, zb      REAL za, zb
401      REAL zx_t, zx_qs, zdelta, zcor      REAL zx_t, zx_qs, zcor
402      real zqsat(klon, llm)      real zqsat(klon, llm)
403      INTEGER i, k, iq, nsrf      INTEGER i, k, iq, nsrf
404      REAL, PARAMETER:: t_coup = 234.      REAL, PARAMETER:: t_coup = 234.
# Line 503  contains Line 503  contains
503      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.
504      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.
505    
     REAL zsto  
506      real date0      real date0
507    
508      ! Variables li\'ees au bilan d'\'energie et d'enthalpie :      ! Variables li\'ees au bilan d'\'energie et d'enthalpie :
509      REAL ztsol(klon)      REAL ztsol(klon)
510      REAL d_h_vcol, d_qt, d_ec      REAL d_h_vcol, d_qt, d_ec
511      REAL, SAVE:: d_h_vcol_phy      REAL, SAVE:: d_h_vcol_phy
     REAL fs_bound, fq_bound  
512      REAL zero_v(klon)      REAL zero_v(klon)
513      CHARACTER(LEN = 20) tit      CHARACTER(LEN = 20) tit
514      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics      INTEGER:: ip_ebil = 0 ! print level for energy conservation diagnostics
# Line 574  contains Line 572  contains
572    
573      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
574    
575      namelist /physiq_nml/ ocean, ok_veget, ok_journe, ok_mensuel, ok_instan, &      namelist /physiq_nml/ ok_journe, ok_mensuel, ok_instan, fact_cldcon, &
576           fact_cldcon, facttemps, ok_newmicro, iflag_cldcon, ratqsbas, &           facttemps, ok_newmicro, iflag_cldcon, ratqsbas, ratqshaut, if_ebil, &
577           ratqshaut, if_ebil, ok_ade, ok_aie, bl95_b0, bl95_b1, iflag_thermals, &           ok_ade, ok_aie, bl95_b0, bl95_b1, iflag_thermals, nsplit_thermals
          nsplit_thermals  
578    
579      !----------------------------------------------------------------      !----------------------------------------------------------------
580    
# Line 636  contains Line 633  contains
633         frugs = 0.         frugs = 0.
634         itap = 0         itap = 0
635         itaprad = 0         itaprad = 0
636         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &         CALL phyetat0(pctsrf, ftsol, ftsoil, tslab, seaice, fqsurf, qsol, &
637              seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, &              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollw, &
638              snow_fall, solsw, sollw, dlw, radsol, frugs, agesno, zmea, &              dlw, radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, &
639              zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, &              zval, t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon, &
640              ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)              run_off_lic_0, sig1, w01)
641    
642         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial         ! ATTENTION : il faudra a terme relire q2 dans l'etat initial
643         q2 = 1e-8         q2 = 1e-8
# Line 650  contains Line 647  contains
647         ! on remet le calendrier a zero         ! on remet le calendrier a zero
648         IF (raz_date) itau_phy = 0         IF (raz_date) itau_phy = 0
649    
650         PRINT *, 'cycle_diurne = ', cycle_diurne         CALL printflag(radpas, ok_journe, ok_instan, ok_region)
        CALL printflag(radpas, ocean /= 'force', ok_journe, ok_instan, ok_region)  
651    
652         IF (dtphys * REAL(radpas) > 21600. .AND. cycle_diurne) THEN         IF (dtphys * radpas > 21600. .AND. cycle_diurne) THEN
653            print *, "Au minimum 4 appels par jour si cycle diurne"            print *, "Au minimum 4 appels par jour si cycle diurne"
654            call abort_gcm('physiq', &            call abort_gcm('physiq', &
655                 "Nombre d'appels au rayonnement insuffisant", 1)                 "Nombre d'appels au rayonnement insuffisant", 1)
# Line 684  contains Line 680  contains
680         ! Initialisation des sorties         ! Initialisation des sorties
681    
682         call ini_histins(dtphys, ok_instan, nid_ins)         call ini_histins(dtphys, ok_instan, nid_ins)
683         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, day_ref, 0., date0)
684         ! Positionner date0 pour initialisation de ORCHIDEE         ! Positionner date0 pour initialisation de ORCHIDEE
685         print *, 'physiq date0: ', date0         print *, 'physiq date0: ', date0
686      ENDIF test_firstcal      ENDIF test_firstcal
687    
     ! Mettre a zero des variables de sortie (pour securite)  
     da = 0.  
     mp = 0.  
     phi = 0.  
   
688      ! We will modify variables *_seri and we will not touch variables      ! We will modify variables *_seri and we will not touch variables
689      ! u, v, t, qx:      ! u, v, t, qx:
690      t_seri = t      t_seri = t
# Line 749  contains Line 740  contains
740    
741      ! Incrémenter le compteur de la physique      ! Incrémenter le compteur de la physique
742      itap = itap + 1      itap = itap + 1
743      julien = MOD(NINT(rdayvrai), 360)      julien = MOD(dayvrai, 360)
744      if (julien == 0) julien = 360      if (julien == 0) julien = 360
745    
746      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k + 1)) / rg      forall (k = 1: llm) zmasse(:, k) = (paprs(:, k) - paprs(:, k + 1)) / rg
747    
748      ! Prescrire l'ozone :      ! Prescrire l'ozone :
749      wo = ozonecm(REAL(julien), paprs)      wo = ozonecm(REAL(julien), paprs)
# Line 779  contains Line 770  contains
770      frugs = MAX(frugs, 0.000015)      frugs = MAX(frugs, 0.000015)
771      zxrugs = sum(frugs * pctsrf, dim = 2)      zxrugs = sum(frugs * pctsrf, dim = 2)
772    
773      ! Calculs nécessaires au calcul de l'albedo dans l'interface      ! Calculs nécessaires au calcul de l'albedo dans l'interface avec
774        ! la surface.
775    
776      CALL orbite(REAL(julien), zlongi, dist)      CALL orbite(REAL(julien), longi, dist)
777      IF (cycle_diurne) THEN      IF (cycle_diurne) THEN
778         CALL zenang(zlongi, time, dtphys * REAL(radpas), rmu0, fract)         CALL zenang(longi, time, dtphys * radpas, mu0, fract)
779      ELSE      ELSE
780         rmu0 = -999.999         mu0 = -999.999
781      ENDIF      ENDIF
782    
783      ! Calcul de l'abedo moyen par maille      ! Calcul de l'abedo moyen par maille
# Line 806  contains Line 798  contains
798      ! Couche limite:      ! Couche limite:
799    
800      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, &
801           v_seri, julien, rmu0, co2_ppm, ok_veget, ocean, ftsol, soil_model, &           v_seri, julien, mu0, co2_ppm, ftsol, cdmmax, cdhmax, &
802           cdmmax, cdhmax, ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, play, &           ksta, ksta_ter, ok_kzmin, ftsoil, qsol, paprs, play, fsnow, fqsurf, &
803           fsnow, fqsurf, fevap, falbe, falblw, fluxlat, rain_fall, snow_fall, &           fevap, falbe, falblw, fluxlat, rain_fall, snow_fall, fsolsw, fsollw, &
804           fsolsw, fsollw, fder, rlon, rlat, frugs, firstcal, agesno, rugoro, &           fder, rlat, frugs, firstcal, agesno, rugoro, d_t_vdf, d_q_vdf, &
805           d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, &           d_u_vdf, d_v_vdf, d_ts, fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, &
806           fluxv, cdragh, cdragm, q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, &           q2, dsens, devap, ycoefh, yu1, yv1, t2m, q2m, u10m, v10m, pblh, &
807           u10m, v10m, pblh, capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, &           capCL, oliqCL, cteiCL, pblT, therm, trmb1, trmb2, trmb3, plcl, &
808           trmb3, plcl, fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab, &           fqcalving, ffonte, run_off_lic_0, fluxo, fluxg, tslab)
          seaice)  
809    
810      ! Incr\'ementation des flux      ! Incr\'ementation des flux
811    
# Line 941  contains Line 932  contains
932         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3         dlw(i) = - 4. * RSIGMA * zxtsol(i)**3
933      ENDDO      ENDDO
934    
     ! 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  
   
935      IF (check) print *, "avantcon = ", qcheck(paprs, q_seri, ql_seri)      IF (check) print *, "avantcon = ", qcheck(paprs, q_seri, ql_seri)
936    
937        ! Appeler la convection (au choix)
938    
939      if (iflag_con == 2) then      if (iflag_con == 2) then
940           conv_q = d_q_dyn + d_q_vdf / dtphys
941           conv_t = d_t_dyn + d_t_vdf / dtphys
942         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)         z_avant = sum((q_seri + ql_seri) * zmasse, dim=2)
943         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:-1), &         CALL conflx(dtphys, paprs, play, t_seri(:, llm:1:-1), &
944              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 966  contains Line 952  contains
952      else      else
953         ! iflag_con >= 3         ! iflag_con >= 3
954    
955           da = 0.
956           mp = 0.
957           phi = 0.
958         CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, &         CALL concvl(dtphys, paprs, play, t_seri, q_seri, u_seri, v_seri, sig1, &
959              w01, d_t_con, d_q_con, d_u_con, d_v_con, rain_con, snow_con, &              w01, d_t_con, d_q_con, d_u_con, d_v_con, rain_con, snow_con, &
960              ibas_con, itop_con, upwd, dnwd, dnwd0, Ma, cape, iflagctrl, &              ibas_con, itop_con, upwd, dnwd, dnwd0, Ma, cape, iflagctrl, &
# Line 974  contains Line 963  contains
963         mfu = upwd + dnwd         mfu = upwd + dnwd
964         IF (.NOT. ok_gust) wd = 0.         IF (.NOT. ok_gust) wd = 0.
965    
966         ! Calcul des propri\'et\'es des nuages convectifs         IF (thermcep) THEN
967              zqsat = MIN(0.5, r2es * FOEEW(t_seri, rtt >= t_seri) / play)
968         DO k = 1, llm            zqsat = zqsat / (1. - retv * zqsat)
969            DO i = 1, klon         ELSE
970               IF (thermcep) THEN            zqsat = merge(qsats(t_seri), qsatl(t_seri), t_seri < t_coup) / play
971                  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  
972    
973         ! calcul des proprietes des nuages convectifs         ! Properties of convective clouds
974         clwcon0 = fact_cldcon * clwcon0         clwcon0 = fact_cldcon * clwcon0
975         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &         call clouds_gno(klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, &
976              rnebcon0)              rnebcon0)
# Line 1232  contains Line 1209  contains
1209         DO i = 1, klon         DO i = 1, klon
1210            zx_t = t_seri(i, k)            zx_t = t_seri(i, k)
1211            IF (thermcep) THEN            IF (thermcep) THEN
1212               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)  
1213               zx_qs = MIN(0.5, zx_qs)               zx_qs = MIN(0.5, zx_qs)
1214               zcor = 1./(1.-retv*zx_qs)               zcor = 1./(1.-retv*zx_qs)
1215               zx_qs = zx_qs*zcor               zx_qs = zx_qs*zcor
# Line 1252  contains Line 1228  contains
1228      ! Introduce the aerosol direct and first indirect radiative forcings:      ! Introduce the aerosol direct and first indirect radiative forcings:
1229      IF (ok_ade .OR. ok_aie) THEN      IF (ok_ade .OR. ok_aie) THEN
1230         ! Get sulfate aerosol distribution :         ! Get sulfate aerosol distribution :
1231         CALL readsulfate(rdayvrai, firstcal, sulfate)         CALL readsulfate(dayvrai, time, firstcal, sulfate)
1232         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)         CALL readsulfate_preind(dayvrai, time, firstcal, sulfate_pi)
1233    
1234         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, &
1235              aerindex)              aerindex)
# Line 1275  contains Line 1251  contains
1251              bl95_b1, cldtaupi, re, fl)              bl95_b1, cldtaupi, re, fl)
1252      endif      endif
1253    
     ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.  
1254      IF (MOD(itaprad, radpas) == 0) THEN      IF (MOD(itaprad, radpas) == 0) THEN
1255           ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
1256         DO i = 1, klon         DO i = 1, klon
1257            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &            albsol(i) = falbe(i, is_oce) * pctsrf(i, is_oce) &
1258                 + falbe(i, is_lic) * pctsrf(i, is_lic) &                 + falbe(i, is_lic) * pctsrf(i, is_lic) &
# Line 1288  contains Line 1264  contains
1264                 + falblw(i, is_sic) * pctsrf(i, is_sic)                 + falblw(i, is_sic) * pctsrf(i, is_sic)
1265         ENDDO         ENDDO
1266         ! Rayonnement (compatible Arpege-IFS) :         ! Rayonnement (compatible Arpege-IFS) :
1267         CALL radlwsw(dist, rmu0, fract, paprs, play, zxtsol, albsol, &         CALL radlwsw(dist, mu0, fract, paprs, play, zxtsol, albsol, &
1268              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &              albsollw, t_seri, q_seri, wo, cldfra, cldemi, cldtau, heat, &
1269              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &              heat0, cool, cool0, radsol, albpla, topsw, toplw, solsw, sollw, &
1270              sollwdown, topsw0, toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, &              sollwdown, topsw0, toplw0, solsw0, sollw0, lwdn0, lwdn, lwup0, &
# Line 1296  contains Line 1272  contains
1272              cg_ae, topswad, solswad, cldtaupi, topswai, solswai)              cg_ae, topswad, solswad, cldtaupi, topswai, solswai)
1273         itaprad = 0         itaprad = 0
1274      ENDIF      ENDIF
1275    
1276      itaprad = itaprad + 1      itaprad = itaprad + 1
1277    
1278      ! Ajouter la tendance des rayonnements (tous les pas)      ! Ajouter la tendance des rayonnements (tous les pas)
# Line 1347  contains Line 1324  contains
1324         ENDDO         ENDDO
1325    
1326         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &         CALL drag_noro(klon, llm, dtphys, paprs, play, zmea, zstd, zsig, zgam, &
1327              zthe, zpic, zval, igwd, idx, itest, t_seri, u_seri, v_seri, &              zthe, zpic, zval, itest, t_seri, u_seri, v_seri, zulow, zvlow, &
1328              zulow, zvlow, zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)              zustrdr, zvstrdr, d_t_oro, d_u_oro, d_v_oro)
1329    
1330         ! ajout des tendances         ! ajout des tendances
1331         DO k = 1, llm         DO k = 1, llm
# Line 1409  contains Line 1386  contains
1386           d_qt, d_ec)           d_qt, d_ec)
1387    
1388      ! Calcul des tendances traceurs      ! Calcul des tendances traceurs
1389      call phytrac(itap, lmt_pas, julien, time, firstcal, lafin, dtphys, u, t, &      call phytrac(itap, lmt_pas, julien, time, firstcal, lafin, dtphys, t, &
1390           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, &
1391           yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, pphis, albsol, rhcl, &           yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, pphis, da, phi, mp, &
1392           cldfra, rneb, diafra, cldliq, pmflxr, pmflxs, prfl, psfl, da, phi, &           upwd, dnwd, tr_seri, zmasse)
          mp, upwd, dnwd, tr_seri, zmasse)  
1393    
1394      IF (offline) call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, &      IF (offline) call phystokenc(dtphys, rlon, rlat, t, mfu, mfd, pen_u, &
1395           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 1498  contains Line 1474  contains
1474      ! Si c'est la fin, il faut conserver l'etat de redemarrage      ! Si c'est la fin, il faut conserver l'etat de redemarrage
1475      IF (lafin) THEN      IF (lafin) THEN
1476         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1477         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, ftsoil, &         CALL phyredem("restartphy.nc", pctsrf, ftsol, ftsoil, tslab, seaice, &
1478              tslab, seaice, fqsurf, qsol, fsnow, falbe, falblw, fevap, &              fqsurf, qsol, fsnow, falbe, falblw, fevap, rain_fall, snow_fall, &
1479              rain_fall, snow_fall, solsw, sollw, dlw, radsol, frugs, &              solsw, sollw, dlw, radsol, frugs, agesno, zmea, zstd, zsig, zgam, &
1480              agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &              zthe, zpic, zval, t_ancien, q_ancien, rnebcon, ratqs, clwcon, &
1481              q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)              run_off_lic_0, sig1, w01)
1482      ENDIF      ENDIF
1483    
1484      firstcal = .FALSE.      firstcal = .FALSE.
# Line 1517  contains Line 1493  contains
1493        USE histsync_m, ONLY: histsync        USE histsync_m, ONLY: histsync
1494        USE histwrite_m, ONLY: histwrite        USE histwrite_m, ONLY: histwrite
1495    
1496        real zout        integer i, itau_w ! pas de temps ecriture
       integer itau_w ! pas de temps ecriture  
1497        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)
1498    
1499        !--------------------------------------------------        !--------------------------------------------------
# Line 1526  contains Line 1501  contains
1501        IF (ok_instan) THEN        IF (ok_instan) THEN
1502           ! Champs 2D:           ! Champs 2D:
1503    
          zsto = dtphys * ecrit_ins  
          zout = dtphys * ecrit_ins  
1504           itau_w = itau_phy + itap           itau_w = itau_phy + itap
1505    
          i = NINT(zout/zsto)  
1506           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)
1507           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)
1508    
          i = NINT(zout/zsto)  
1509           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)
1510           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)
1511    
Legend:
Removed from v.98  
changed lines
  Added in v.151
  ViewVC Help
Powered by ViewVC 1.1.21