/[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 6 by guez, Tue Mar 4 14:00:42 2008 UTC revision 15 by guez, Fri Aug 1 15:24:12 2008 UTC
# Line 9  module physiq_m Line 9  module physiq_m
9    
10  contains  contains
11    
12    SUBROUTINE physiq (nq, debut, lafin, rjourvrai, gmtime, pdtphys, paprs, &    SUBROUTINE physiq(nq, firstcal, lafin, rdayvrai, gmtime, pdtphys, paprs, &
13         pplay, pphi, pphis, presnivs, clesphy0, u, v, t, qx, omega, d_u, d_v, &         pplay, pphi, pphis, presnivs, u, v, t, qx, omega, d_u, d_v, &
14         d_t, d_qx, d_ps, dudyn, PVteta)         d_t, d_qx, d_ps, dudyn, PVteta)
15    
16      ! From phylmd/physiq.F, v 1.22 2006/02/20 09:38:28      ! From phylmd/physiq.F, v 1.22 2006/02/20 09:38:28
# Line 31  contains Line 31  contains
31      use conf_gcm_m, only: raz_date, offline, iphysiq      use conf_gcm_m, only: raz_date, offline, iphysiq
32      use dimsoil, only: nsoilmx      use dimsoil, only: nsoilmx
33      use temps, only: itau_phy, day_ref, annee_ref, itaufin      use temps, only: itau_phy, day_ref, annee_ref, itaufin
34      use clesphys, only: ecrit_hf, ecrit_hf2mth, &      use clesphys, only: ecrit_hf, ecrit_ins, ecrit_mth, &
35           ecrit_ins, iflag_con, ok_orolf, ok_orodr, ecrit_mth, ecrit_day, &           cdmmax, cdhmax, &
36           nbapp_rad, cycle_diurne, cdmmax, cdhmax, &           co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, &
37           co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, new_oliq, &           ok_kzmin
38           ok_kzmin, soil_model      use clesphys2, only: iflag_con, ok_orolf, ok_orodr, nbapp_rad, &
39      use iniprint, only: lunout, prt_level           cycle_diurne, new_oliq, soil_model
40        use iniprint, only: prt_level
41      use abort_gcm_m, only: abort_gcm      use abort_gcm_m, only: abort_gcm
42      use YOMCST, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega      use YOMCST, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega
43      use comgeomphy      use comgeomphy
# Line 51  contains Line 52  contains
52      use phyetat0_m, only: phyetat0, rlat, rlon      use phyetat0_m, only: phyetat0, rlat, rlon
53      use hgardfou_m, only: hgardfou      use hgardfou_m, only: hgardfou
54      use conf_phys_m, only: conf_phys      use conf_phys_m, only: conf_phys
55        use phyredem_m, only: phyredem
56    
57      ! Declaration des constantes et des fonctions thermodynamiques :      ! Declaration des constantes et des fonctions thermodynamiques :
58      use fcttre, only: thermcep, foeew, qsats, qsatl      use fcttre, only: thermcep, foeew, qsats, qsatl
# Line 58  contains Line 60  contains
60      ! Variables argument:      ! Variables argument:
61    
62      INTEGER nq ! input nombre de traceurs (y compris vapeur d'eau)      INTEGER nq ! input nombre de traceurs (y compris vapeur d'eau)
63      REAL rjourvrai ! input numero du jour de l'experience  
64        REAL, intent(in):: rdayvrai
65        ! (elapsed time since January 1st 0h of the starting year, in days)
66    
67      REAL, intent(in):: gmtime ! heure de la journée en fraction de jour      REAL, intent(in):: gmtime ! heure de la journée en fraction de jour
68      REAL pdtphys ! input pas d'integration pour la physique (seconde)      REAL, intent(in):: pdtphys ! pas d'integration pour la physique (seconde)
69      LOGICAL, intent(in):: debut ! premier passage      LOGICAL, intent(in):: firstcal ! first call to "calfis"
70      logical, intent(in):: lafin ! dernier passage      logical, intent(in):: lafin ! dernier passage
71    
72      REAL, intent(in):: paprs(klon, llm+1)      REAL, intent(in):: paprs(klon, llm+1)
73      ! (pression pour chaque inter-couche, en Pa)      ! (pression pour chaque inter-couche, en Pa)
74        
75      REAL pplay(klon, llm)      REAL, intent(in):: pplay(klon, llm)
76      ! (input pression pour le mileu de chaque couche (en Pa))      ! (input pression pour le mileu de chaque couche (en Pa))
77    
78      REAL pphi(klon, llm)        REAL pphi(klon, llm)  
# Line 82  contains Line 87  contains
87      REAL v(klon, llm)  ! input vitesse Y (de S a N) en m/s      REAL v(klon, llm)  ! input vitesse Y (de S a N) en m/s
88      REAL t(klon, llm)  ! input temperature (K)      REAL t(klon, llm)  ! input temperature (K)
89    
90      REAL qx(klon, llm, nq)      REAL, intent(in):: qx(klon, llm, nq)
91      ! (input humidite specifique (kg/kg) et d'autres traceurs)      ! (humidite specifique (kg/kg) et fractions massiques des autres traceurs)
92    
93      REAL omega(klon, llm)  ! input vitesse verticale en Pa/s      REAL omega(klon, llm)  ! input vitesse verticale en Pa/s
94      REAL d_u(klon, llm)  ! output tendance physique de "u" (m/s/s)      REAL d_u(klon, llm)  ! output tendance physique de "u" (m/s/s)
# Line 112  contains Line 117  contains
117      INTEGER, SAVE :: npas, nexca      INTEGER, SAVE :: npas, nexca
118      logical rnpb      logical rnpb
119      parameter(rnpb=.true.)      parameter(rnpb=.true.)
120      !      ocean = type de modele ocean a utiliser: force, slab, couple  
121      character(len=6) ocean      character(len=6), save:: ocean
122      SAVE ocean      ! (type de modèle océan à utiliser: "force" ou "slab" mais pas "couple")
123    
124      logical ok_ocean      logical ok_ocean
125      SAVE ok_ocean      SAVE ok_ocean
# Line 317  contains Line 322  contains
322    
323      INTEGER        longcles      INTEGER        longcles
324      PARAMETER    ( longcles = 20 )      PARAMETER    ( longcles = 20 )
     REAL clesphy0( longcles      )  
   
     ! Variables quasi-arguments  
   
     REAL xjour  
     SAVE xjour  
325    
326      ! Variables propres a la physique      ! Variables propres a la physique
327    
     REAL, SAVE:: dtime ! pas temporel de la physique (s)  
   
328      INTEGER, save:: radpas      INTEGER, save:: radpas
329      ! (Radiative transfer computations are made every "radpas" call to      ! (Radiative transfer computations are made every "radpas" call to
330      ! "physiq".)      ! "physiq".)
# Line 335  contains Line 332  contains
332      REAL radsol(klon)      REAL radsol(klon)
333      SAVE radsol               ! bilan radiatif au sol calcule par code radiatif      SAVE radsol               ! bilan radiatif au sol calcule par code radiatif
334    
335      INTEGER, SAVE:: itap ! compteur pour la physique      INTEGER, SAVE:: itap ! number of calls to "physiq"
     REAL co2_ppm_etat0  
     REAL solaire_etat0  
336    
337      REAL ftsol(klon, nbsrf)      REAL ftsol(klon, nbsrf)
338      SAVE ftsol                  ! temperature du sol      SAVE ftsol                  ! temperature du sol
# Line 364  contains Line 359  contains
359      REAL falblw(klon, nbsrf)      REAL falblw(klon, nbsrf)
360      SAVE falblw                 ! albedo par type de surface      SAVE falblw                 ! albedo par type de surface
361    
362      !  Parametres de l'Orographie a l'Echelle Sous-Maille (OESM):      ! Paramètres de l'orographie à l'échelle sous-maille (OESM) :
363        REAL, save:: zmea(klon) ! orographie moyenne
364      REAL zmea(klon)      REAL, save:: zstd(klon) ! deviation standard de l'OESM
365      SAVE zmea                   ! orographie moyenne      REAL, save:: zsig(klon) ! pente de l'OESM
366        REAL, save:: zgam(klon) ! anisotropie de l'OESM
367      REAL zstd(klon)      REAL, save:: zthe(klon) ! orientation de l'OESM
368      SAVE zstd                   ! deviation standard de l'OESM      REAL, save:: zpic(klon) ! Maximum de l'OESM
369        REAL, save:: zval(klon) ! Minimum de l'OESM
370      REAL zsig(klon)      REAL, save:: rugoro(klon) ! longueur de rugosite de l'OESM
     SAVE zsig                   ! pente de l'OESM  
   
     REAL zgam(klon)  
     save zgam                   ! anisotropie de l'OESM  
   
     REAL zthe(klon)  
     SAVE zthe                   ! orientation de l'OESM  
   
     REAL zpic(klon)  
     SAVE zpic                   ! Maximum de l'OESM  
   
     REAL zval(klon)  
     SAVE zval                   ! Minimum de l'OESM  
   
     REAL rugoro(klon)  
     SAVE rugoro                 ! longueur de rugosite de l'OESM  
371    
372      REAL zulow(klon), zvlow(klon)      REAL zulow(klon), zvlow(klon)
373    
# Line 449  contains Line 428  contains
428      !IM cf FH pour Tiedtke 080604      !IM cf FH pour Tiedtke 080604
429      REAL rain_tiedtke(klon), snow_tiedtke(klon)      REAL rain_tiedtke(klon), snow_tiedtke(klon)
430    
     REAL total_rain(klon), nday_rain(klon)  
     save nday_rain  
   
431      REAL evap(klon), devap(klon) ! evaporation et sa derivee      REAL evap(klon), devap(klon) ! evaporation et sa derivee
432      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee      REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
433      REAL dlw(klon)    ! derivee infra rouge      REAL dlw(klon)    ! derivee infra rouge
# Line 472  contains Line 448  contains
448    
449      INTEGER julien      INTEGER julien
450    
451      INTEGER, SAVE:: lmt_pas ! fréquence de mise à jour      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day
452      REAL pctsrf(klon, nbsrf)      REAL pctsrf(klon, nbsrf)
453      !IM      !IM
454      REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE      REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE
# Line 495  contains Line 471  contains
471      EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)      EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)
472      EXTERNAL nuage     ! calculer les proprietes radiatives      EXTERNAL nuage     ! calculer les proprietes radiatives
473      EXTERNAL ozonecm   ! prescrire l'ozone      EXTERNAL ozonecm   ! prescrire l'ozone
     EXTERNAL phyredem  ! ecrire l'etat de redemarrage de la physique  
474      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge      EXTERNAL radlwsw   ! rayonnements solaire et infrarouge
475      EXTERNAL transp    ! transport total de l'eau et de l'energie      EXTERNAL transp    ! transport total de l'eau et de l'energie
476    
477      EXTERNAL ini_undefSTD  !initialise a 0 une variable a 1 niveau de pression      EXTERNAL ini_undefSTD  !initialise a 0 une variable a 1 niveau de pression
478      EXTERNAL undefSTD !somme les valeurs definies d'1 var a 1 niveau de pression  
479        EXTERNAL undefSTD
480        ! (somme les valeurs definies d'1 var a 1 niveau de pression)
481    
482      ! Variables locales      ! Variables locales
483    
# Line 675  contains Line 652  contains
652      REAL d_tr(klon, llm, nbtr)      REAL d_tr(klon, llm, nbtr)
653    
654      REAL zx_rh(klon, llm)      REAL zx_rh(klon, llm)
   
     INTEGER        length  
     PARAMETER    ( length = 100 )  
     REAL tabcntr0( length       )  
   
655      INTEGER ndex2d(iim*(jjm + 1)), ndex3d(iim*(jjm + 1)*llm)      INTEGER ndex2d(iim*(jjm + 1)), ndex3d(iim*(jjm + 1)*llm)
656    
657      REAL zustrdr(klon), zvstrdr(klon)      REAL zustrdr(klon), zvstrdr(klon)
# Line 694  contains Line 666  contains
666    
667      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)
668    
669      INTEGER nid_day, nid_ins      INTEGER, SAVE:: nid_day, nid_ins
     SAVE nid_day, nid_ins  
670    
671      REAL ve_lay(klon, llm) ! transport meri. de l'energie a chaque niveau vert.      REAL ve_lay(klon, llm) ! transport meri. de l'energie a chaque niveau vert.
672      REAL vq_lay(klon, llm) ! transport meri. de l'eau a chaque niveau vert.      REAL vq_lay(klon, llm) ! transport meri. de l'eau a chaque niveau vert.
# Line 802  contains Line 773  contains
773         END DO         END DO
774      END IF      END IF
775      ok_sync=.TRUE.      ok_sync=.TRUE.
776      IF (nq .LT. 2) THEN      IF (nq  <  2) THEN
777         abort_message = 'eaux vapeur et liquide sont indispensables'         abort_message = 'eaux vapeur et liquide sont indispensables'
778         CALL abort_gcm (modname, abort_message, 1)         CALL abort_gcm(modname, abort_message, 1)
779      ENDIF      ENDIF
780    
781      xjour = rjourvrai      test_firstcal: IF (firstcal) THEN
   
     test_debut: IF (debut) THEN  
782         !  initialiser         !  initialiser
783         u10m(:, :)=0.         u10m=0.
784         v10m(:, :)=0.         v10m=0.
785         t2m(:, :)=0.         t2m=0.
786         q2m(:, :)=0.         q2m=0.
787         ffonte(:, :)=0.         ffonte=0.
788         fqcalving(:, :)=0.         fqcalving=0.
789         piz_ae(:, :, :)=0.         piz_ae(:, :, :)=0.
790         tau_ae(:, :, :)=0.         tau_ae(:, :, :)=0.
791         cg_ae(:, :, :)=0.         cg_ae(:, :, :)=0.
# Line 829  contains Line 798  contains
798         solswai(:)=0.         solswai(:)=0.
799         solswad(:)=0.         solswad(:)=0.
800    
801         d_u_con(:, :) = 0.0         d_u_con = 0.0
802         d_v_con(:, :) = 0.0         d_v_con = 0.0
803         rnebcon0(:, :) = 0.0         rnebcon0 = 0.0
804         clwcon0(:, :) = 0.0         clwcon0 = 0.0
805         rnebcon(:, :) = 0.0         rnebcon = 0.0
806         clwcon(:, :) = 0.0         clwcon = 0.0
807    
808         pblh(:, :)   =0.        ! Hauteur de couche limite         pblh   =0.        ! Hauteur de couche limite
809         plcl(:, :)   =0.        ! Niveau de condensation de la CLA         plcl   =0.        ! Niveau de condensation de la CLA
810         capCL(:, :)  =0.        ! CAPE de couche limite         capCL  =0.        ! CAPE de couche limite
811         oliqCL(:, :) =0.        ! eau_liqu integree de couche limite         oliqCL =0.        ! eau_liqu integree de couche limite
812         cteiCL(:, :) =0.        ! cloud top instab. crit. couche limite         cteiCL =0.        ! cloud top instab. crit. couche limite
813         pblt(:, :)   =0.        ! T a la Hauteur de couche limite         pblt   =0.        ! T a la Hauteur de couche limite
814         therm(:, :)  =0.         therm  =0.
815         trmb1(:, :)  =0.        ! deep_cape         trmb1  =0.        ! deep_cape
816         trmb2(:, :)  =0.        ! inhibition         trmb2  =0.        ! inhibition
817         trmb3(:, :)  =0.        ! Point Omega         trmb3  =0.        ! Point Omega
818    
819         IF (if_ebil >= 1) d_h_vcol_phy=0.         IF (if_ebil >= 1) d_h_vcol_phy=0.
820    
# Line 863  contains Line 832  contains
832         frugs = 0.         frugs = 0.
833         itap = 0         itap = 0
834         itaprad = 0         itaprad = 0
835         CALL phyetat0("startphy.nc", dtime, co2_ppm_etat0, solaire_etat0, &         CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &
836              pctsrf, ftsol, ftsoil, &              seaice, fqsurf, qsol, fsnow, &
             ocean, tslab, seaice, & !IM "slab" ocean  
             fqsurf, qsol, fsnow, &  
837              falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollwdown, &              falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollwdown, &
838              dlw, radsol, frugs, agesno, clesphy0, &              dlw, radsol, frugs, agesno, &
839              zmea, zstd, zsig, zgam, zthe, zpic, zval, rugoro, tabcntr0, &              zmea, zstd, zsig, zgam, zthe, zpic, zval, &
840              t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon,  &              t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon,  &
841              run_off_lic_0)              run_off_lic_0)
842    
843         !   ATTENTION : il faudra a terme relire q2 dans l'etat initial         !   ATTENTION : il faudra a terme relire q2 dans l'etat initial
844         q2(:, :, :)=1.e-8         q2(:, :, :)=1.e-8
845    
846         radpas = NINT( 86400. / dtime / nbapp_rad)         radpas = NINT( 86400. / pdtphys / nbapp_rad)
847    
848         ! on remet le calendrier a zero         ! on remet le calendrier a zero
849           IF (raz_date) itau_phy = 0
850    
851         IF (raz_date == 1) THEN         PRINT *, 'cycle_diurne = ', cycle_diurne
           itau_phy = 0  
        ENDIF  
   
        PRINT*, 'cycle_diurne =', cycle_diurne  
852    
853         IF(ocean.NE.'force ') THEN         IF(ocean.NE.'force ') THEN
854            ok_ocean=.TRUE.            ok_ocean=.TRUE.
855         ENDIF         ENDIF
856    
857         CALL printflag( tabcntr0, radpas, ok_ocean, ok_oasis, ok_journe, &         CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &
858              ok_instan, ok_region )              ok_region)
   
        IF (ABS(dtime-pdtphys).GT.0.001) THEN  
           WRITE(lunout, *) 'Pas physique n est pas correct', dtime, &  
                pdtphys  
           abort_message='Pas physique n est pas correct '  
           call abort_gcm(modname, abort_message, 1)  
        ENDIF  
859    
860         IF (dtime*REAL(radpas).GT.21600..AND.cycle_diurne) THEN         IF (pdtphys*REAL(radpas).GT.21600..AND.cycle_diurne) THEN
861            WRITE(lunout, *)'Nbre d appels au rayonnement insuffisant'            print *,'Nbre d appels au rayonnement insuffisant'
862            WRITE(lunout, *)"Au minimum 4 appels par jour si cycle diurne"            print *,"Au minimum 4 appels par jour si cycle diurne"
863            abort_message='Nbre d appels au rayonnement insuffisant'            abort_message='Nbre d appels au rayonnement insuffisant'
864            call abort_gcm(modname, abort_message, 1)            call abort_gcm(modname, abort_message, 1)
865         ENDIF         ENDIF
866         WRITE(lunout, *)"Clef pour la convection, iflag_con=", iflag_con         print *,"Clef pour la convection, iflag_con=", iflag_con
867         WRITE(lunout, *)"Clef pour le driver de la convection, ok_cvl=", &         print *,"Clef pour le driver de la convection, ok_cvl=", &
868              ok_cvl              ok_cvl
869    
870         ! Initialisation pour la convection de K.E. (sb):         ! Initialisation pour la convection de K.E. (sb):
871         IF (iflag_con >= 3) THEN         IF (iflag_con >= 3) THEN
872    
873            WRITE(lunout, *)"*** Convection de Kerry Emanuel 4.3  "            print *,"*** Convection de Kerry Emanuel 4.3  "
874    
875            !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>BEG            !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>BEG
876            DO i = 1, klon            DO i = 1, klon
# Line 925  contains Line 882  contains
882         ENDIF         ENDIF
883    
884         IF (ok_orodr) THEN         IF (ok_orodr) THEN
885            DO i=1, klon            rugoro = MAX(1e-5, zstd * zsig / 2)
              rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)  
           ENDDO  
886            CALL SUGWD(klon, llm, paprs, pplay)            CALL SUGWD(klon, llm, paprs, pplay)
887           else
888              rugoro = 0.
889         ENDIF         ENDIF
890    
891         lmt_pas = NINT(86400. / dtime)  ! tous les jours         lmt_pas = NINT(86400. / pdtphys)  ! tous les jours
892         print *, 'La frequence de lecture surface est de ', lmt_pas         print *, 'Number of time steps of "physics" per day: ', lmt_pas
893    
894         ecrit_ins = NINT(ecrit_ins/dtime)         ecrit_ins = NINT(ecrit_ins/pdtphys)
895         ecrit_hf = NINT(ecrit_hf/dtime)         ecrit_hf = NINT(ecrit_hf/pdtphys)
896         ecrit_day = NINT(ecrit_day/dtime)         ecrit_mth = NINT(ecrit_mth/pdtphys)
897         ecrit_mth = NINT(ecrit_mth/dtime)         ecrit_tra = NINT(86400.*ecrit_tra/pdtphys)
898         ecrit_tra = NINT(86400.*ecrit_tra/dtime)         ecrit_reg = NINT(ecrit_reg/pdtphys)
        ecrit_reg = NINT(ecrit_reg/dtime)  
899    
900         ! Initialiser le couplage si necessaire         ! Initialiser le couplage si necessaire
901    
902         npas = 0         npas = 0
903         nexca = 0         nexca = 0
        if (ocean == 'couple') then  
           npas = itaufin/ iphysiq  
           nexca = 86400 / int(dtime)  
           write(lunout, *)' Ocean couple'  
           write(lunout, *)' Valeurs des pas de temps'  
           write(lunout, *)' npas = ', npas  
           write(lunout, *)' nexca = ', nexca  
        endif  
904    
905         write(lunout, *)'AVANT HIST IFLAG_CON=', iflag_con         print *,'AVANT HIST IFLAG_CON=', iflag_con
906    
907         !   Initialisation des sorties         !   Initialisation des sorties
908    
909         call ini_histhf(dtime, presnivs, nid_hf, nid_hf3d)         call ini_histhf(pdtphys, presnivs, nid_hf, nid_hf3d)
910         call ini_histday(dtime, presnivs, ok_journe, nid_day)         call ini_histday(pdtphys, presnivs, ok_journe, nid_day)
911         call ini_histins(dtime, presnivs, ok_instan, nid_ins)         call ini_histins(pdtphys, presnivs, ok_instan, nid_ins)
912         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
913         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         !XXXPB Positionner date0 pour initialisation de ORCHIDEE
914         WRITE(*, *) 'physiq date0 : ', date0         WRITE(*, *) 'physiq date0 : ', date0
915      ENDIF test_debut      ENDIF test_firstcal
916    
917      ! Mettre a zero des variables de sortie (pour securite)      ! Mettre a zero des variables de sortie (pour securite)
918    
# Line 985  contains Line 933  contains
933            ENDDO            ENDDO
934         ENDDO         ENDDO
935      ENDDO      ENDDO
936      da(:, :)=0.      da=0.
937      mp(:, :)=0.      mp=0.
938      phi(:, :, :)=0.      phi(:, :, :)=0.
939    
940      ! Ne pas affecter les valeurs entrees de u, v, h, et q      ! Ne pas affecter les valeurs entrees de u, v, h, et q
# Line 1018  contains Line 966  contains
966    
967      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
968         ztit='after dynamic'         ztit='after dynamic'
969         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, pdtphys &
970              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
971              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
972         !     Comme les tendances de la physique sont ajoute dans la dynamique,         !     Comme les tendances de la physique sont ajoute dans la dynamique,
973         !     on devrait avoir que la variation d'entalpie par la dynamique         !     on devrait avoir que la variation d'entalpie par la dynamique
# Line 1037  contains Line 985  contains
985      IF (ancien_ok) THEN      IF (ancien_ok) THEN
986         DO k = 1, llm         DO k = 1, llm
987            DO i = 1, klon            DO i = 1, klon
988               d_t_dyn(i, k) = (t_seri(i, k)-t_ancien(i, k))/dtime               d_t_dyn(i, k) = (t_seri(i, k)-t_ancien(i, k))/pdtphys
989               d_q_dyn(i, k) = (q_seri(i, k)-q_ancien(i, k))/dtime               d_q_dyn(i, k) = (q_seri(i, k)-q_ancien(i, k))/pdtphys
990            ENDDO            ENDDO
991         ENDDO         ENDDO
992      ELSE      ELSE
# Line 1065  contains Line 1013  contains
1013    
1014      ! Incrementer le compteur de la physique      ! Incrementer le compteur de la physique
1015    
1016      itap   = itap + 1      itap = itap + 1
1017      julien = MOD(NINT(xjour), 360)      julien = MOD(NINT(rdayvrai), 360)
1018      if (julien == 0) julien = 360      if (julien == 0) julien = 360
1019    
1020      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! Mettre en action les conditions aux limites (albedo, sst, etc.).
# Line 1094  contains Line 1042  contains
1042    
1043      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1044         ztit='after reevap'         ztit='after reevap'
1045         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, pdtphys &
1046              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1047              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1048         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil &
1049              , zero_v, zero_v, zero_v, zero_v, zero_v &              , zero_v, zero_v, zero_v, zero_v, zero_v &
# Line 1125  contains Line 1073  contains
1073    
1074      CALL orbite(REAL(julien), zlongi, dist)      CALL orbite(REAL(julien), zlongi, dist)
1075      IF (cycle_diurne) THEN      IF (cycle_diurne) THEN
1076         zdtime = dtime * REAL(radpas)         zdtime = pdtphys * REAL(radpas)
1077         CALL zenang(zlongi, gmtime, zdtime, rmu0, fract)         CALL zenang(zlongi, gmtime, zdtime, rmu0, fract)
1078      ELSE      ELSE
1079         rmu0 = -999.999         rmu0 = -999.999
# Line 1154  contains Line 1102  contains
1102    
1103      fder = dlw      fder = dlw
1104    
1105      CALL clmain(dtime, itap, date0, pctsrf, pctsrf_new, &      CALL clmain(pdtphys, itap, date0, pctsrf, pctsrf_new, &
1106           t_seri, q_seri, u_seri, v_seri, &           t_seri, q_seri, u_seri, v_seri, &
1107           julien, rmu0, co2_ppm,  &           julien, rmu0, co2_ppm,  &
1108           ok_veget, ocean, npas, nexca, ftsol, &           ok_veget, ocean, npas, nexca, ftsol, &
# Line 1164  contains Line 1112  contains
1112           fluxlat, rain_fall, snow_fall, &           fluxlat, rain_fall, snow_fall, &
1113           fsolsw, fsollw, sollwdown, fder, &           fsolsw, fsollw, sollwdown, fder, &
1114           rlon, rlat, cuphy, cvphy, frugs, &           rlon, rlat, cuphy, cvphy, frugs, &
1115           debut, lafin, agesno, rugoro, &           firstcal, lafin, agesno, rugoro, &
1116           d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, &           d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, &
1117           fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, &           fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, &
1118           q2, dsens, devap, &           q2, dsens, devap, &
# Line 1211  contains Line 1159  contains
1159    
1160      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1161         ztit='after clmain'         ztit='after clmain'
1162         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1163              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1164              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1165         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil &
1166              , zero_v, zero_v, zero_v, zero_v, sens &              , zero_v, zero_v, zero_v, zero_v, sens &
# Line 1282  contains Line 1230  contains
1230    
1231      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1232         DO i = 1, klon         DO i = 1, klon
1233            IF (pctsrf(i, nsrf) .LT. epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf)  <  epsfra) ftsol(i, nsrf) = zxtsol(i)
1234    
1235            IF (pctsrf(i, nsrf) .LT. epsfra) t2m(i, nsrf) = zt2m(i)            IF (pctsrf(i, nsrf)  <  epsfra) t2m(i, nsrf) = zt2m(i)
1236            IF (pctsrf(i, nsrf) .LT. epsfra) q2m(i, nsrf) = zq2m(i)            IF (pctsrf(i, nsrf)  <  epsfra) q2m(i, nsrf) = zq2m(i)
1237            IF (pctsrf(i, nsrf) .LT. epsfra) u10m(i, nsrf) = zu10m(i)            IF (pctsrf(i, nsrf)  <  epsfra) u10m(i, nsrf) = zu10m(i)
1238            IF (pctsrf(i, nsrf) .LT. epsfra) v10m(i, nsrf) = zv10m(i)            IF (pctsrf(i, nsrf)  <  epsfra) v10m(i, nsrf) = zv10m(i)
1239            IF (pctsrf(i, nsrf) .LT. epsfra) ffonte(i, nsrf) = zxffonte(i)            IF (pctsrf(i, nsrf)  <  epsfra) ffonte(i, nsrf) = zxffonte(i)
1240            IF (pctsrf(i, nsrf) .LT. epsfra)  &            IF (pctsrf(i, nsrf)  <  epsfra)  &
1241                 fqcalving(i, nsrf) = zxfqcalving(i)                 fqcalving(i, nsrf) = zxfqcalving(i)
1242            IF (pctsrf(i, nsrf) .LT. epsfra) pblh(i, nsrf)=s_pblh(i)            IF (pctsrf(i, nsrf)  <  epsfra) pblh(i, nsrf)=s_pblh(i)
1243            IF (pctsrf(i, nsrf) .LT. epsfra) plcl(i, nsrf)=s_lcl(i)            IF (pctsrf(i, nsrf)  <  epsfra) plcl(i, nsrf)=s_lcl(i)
1244            IF (pctsrf(i, nsrf) .LT. epsfra) capCL(i, nsrf)=s_capCL(i)            IF (pctsrf(i, nsrf)  <  epsfra) capCL(i, nsrf)=s_capCL(i)
1245            IF (pctsrf(i, nsrf) .LT. epsfra) oliqCL(i, nsrf)=s_oliqCL(i)            IF (pctsrf(i, nsrf)  <  epsfra) oliqCL(i, nsrf)=s_oliqCL(i)
1246            IF (pctsrf(i, nsrf) .LT. epsfra) cteiCL(i, nsrf)=s_cteiCL(i)            IF (pctsrf(i, nsrf)  <  epsfra) cteiCL(i, nsrf)=s_cteiCL(i)
1247            IF (pctsrf(i, nsrf) .LT. epsfra) pblT(i, nsrf)=s_pblT(i)            IF (pctsrf(i, nsrf)  <  epsfra) pblT(i, nsrf)=s_pblT(i)
1248            IF (pctsrf(i, nsrf) .LT. epsfra) therm(i, nsrf)=s_therm(i)            IF (pctsrf(i, nsrf)  <  epsfra) therm(i, nsrf)=s_therm(i)
1249            IF (pctsrf(i, nsrf) .LT. epsfra) trmb1(i, nsrf)=s_trmb1(i)            IF (pctsrf(i, nsrf)  <  epsfra) trmb1(i, nsrf)=s_trmb1(i)
1250            IF (pctsrf(i, nsrf) .LT. epsfra) trmb2(i, nsrf)=s_trmb2(i)            IF (pctsrf(i, nsrf)  <  epsfra) trmb2(i, nsrf)=s_trmb2(i)
1251            IF (pctsrf(i, nsrf) .LT. epsfra) trmb3(i, nsrf)=s_trmb3(i)            IF (pctsrf(i, nsrf)  <  epsfra) trmb3(i, nsrf)=s_trmb3(i)
1252         ENDDO         ENDDO
1253      ENDDO      ENDDO
1254    
# Line 1315  contains Line 1263  contains
1263      DO k = 1, llm      DO k = 1, llm
1264         DO i = 1, klon         DO i = 1, klon
1265            conv_q(i, k) = d_q_dyn(i, k)  &            conv_q(i, k) = d_q_dyn(i, k)  &
1266                 + d_q_vdf(i, k)/dtime                 + d_q_vdf(i, k)/pdtphys
1267            conv_t(i, k) = d_t_dyn(i, k)  &            conv_t(i, k) = d_t_dyn(i, k)  &
1268                 + d_t_vdf(i, k)/dtime                 + d_t_vdf(i, k)/pdtphys
1269         ENDDO         ENDDO
1270      ENDDO      ENDDO
1271      IF (check) THEN      IF (check) THEN
1272         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1273         WRITE(lunout, *) "avantcon=", za         print *, "avantcon=", za
1274      ENDIF      ENDIF
1275      zx_ajustq = .FALSE.      zx_ajustq = .FALSE.
1276      IF (iflag_con == 2) zx_ajustq=.TRUE.      IF (iflag_con == 2) zx_ajustq=.TRUE.
# Line 1340  contains Line 1288  contains
1288      IF (iflag_con == 1) THEN      IF (iflag_con == 1) THEN
1289         stop 'reactiver le call conlmd dans physiq.F'         stop 'reactiver le call conlmd dans physiq.F'
1290      ELSE IF (iflag_con == 2) THEN      ELSE IF (iflag_con == 2) THEN
1291         CALL conflx(dtime, paprs, pplay, t_seri, q_seri, &         CALL conflx(pdtphys, paprs, pplay, t_seri, q_seri, &
1292              conv_t, conv_q, zxfluxq(1, 1), omega, &              conv_t, conv_q, zxfluxq(1, 1), omega, &
1293              d_t_con, d_q_con, rain_con, snow_con, &              d_t_con, d_q_con, rain_con, snow_con, &
1294              pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &              pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
# Line 1361  contains Line 1309  contains
1309         ! (driver commun aux versions 3 et 4)         ! (driver commun aux versions 3 et 4)
1310    
1311         IF (ok_cvl) THEN ! new driver for convectL         IF (ok_cvl) THEN ! new driver for convectL
   
1312            CALL concvl (iflag_con, &            CALL concvl (iflag_con, &
1313                 dtime, paprs, pplay, t_seri, q_seri, &                 pdtphys, paprs, pplay, t_seri, q_seri, &
1314                 u_seri, v_seri, tr_seri, ntra, &                 u_seri, v_seri, tr_seri, ntra, &
1315                 ema_work1, ema_work2, &                 ema_work1, ema_work2, &
1316                 d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &                 d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &
# Line 1375  contains Line 1322  contains
1322                 da, phi, mp)                 da, phi, mp)
1323    
1324            clwcon0=qcondc            clwcon0=qcondc
1325            pmfu(:, :)=upwd(:, :)+dnwd(:, :)            pmfu=upwd+dnwd
   
1326         ELSE ! ok_cvl         ELSE ! ok_cvl
1327            ! MAF conema3 ne contient pas les traceurs            ! MAF conema3 ne contient pas les traceurs
1328            CALL conema3 (dtime, &            CALL conema3 (pdtphys, &
1329                 paprs, pplay, t_seri, q_seri, &                 paprs, pplay, t_seri, q_seri, &
1330                 u_seri, v_seri, tr_seri, ntra, &                 u_seri, v_seri, tr_seri, ntra, &
1331                 ema_work1, ema_work2, &                 ema_work1, ema_work2, &
# Line 1390  contains Line 1336  contains
1336                 pbase &                 pbase &
1337                 , bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr &                 , bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr &
1338                 , clwcon0)                 , clwcon0)
   
1339         ENDIF ! ok_cvl         ENDIF ! ok_cvl
1340    
1341         IF (.NOT. ok_gust) THEN         IF (.NOT. ok_gust) THEN
# Line 1411  contains Line 1356  contains
1356                  zcor   = 1./(1.-retv*zx_qs)                  zcor   = 1./(1.-retv*zx_qs)
1357                  zx_qs  = zx_qs*zcor                  zx_qs  = zx_qs*zcor
1358               ELSE               ELSE
1359                  IF (zx_t.LT.t_coup) THEN                  IF (zx_t < t_coup) THEN
1360                     zx_qs = qsats(zx_t)/pplay(i, k)                     zx_qs = qsats(zx_t)/pplay(i, k)
1361                  ELSE                  ELSE
1362                     zx_qs = qsatl(zx_t)/pplay(i, k)                     zx_qs = qsatl(zx_t)/pplay(i, k)
# Line 1422  contains Line 1367  contains
1367         ENDDO         ENDDO
1368    
1369         !   calcul des proprietes des nuages convectifs         !   calcul des proprietes des nuages convectifs
1370         clwcon0(:, :)=fact_cldcon*clwcon0(:, :)         clwcon0=fact_cldcon*clwcon0
1371         call clouds_gno &         call clouds_gno &
1372              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)
1373      ELSE      ELSE
1374         WRITE(lunout, *) "iflag_con non-prevu", iflag_con         print *, "iflag_con non-prevu", iflag_con
1375         stop 1         stop 1
1376      ENDIF      ENDIF
1377    
# Line 1441  contains Line 1386  contains
1386    
1387      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1388         ztit='after convect'         ztit='after convect'
1389         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1390              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1391              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1392         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil &
1393              , zero_v, zero_v, zero_v, zero_v, zero_v &              , zero_v, zero_v, zero_v, zero_v, zero_v &
# Line 1453  contains Line 1398  contains
1398    
1399      IF (check) THEN      IF (check) THEN
1400         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1401         WRITE(lunout, *)"aprescon=", za         print *,"aprescon=", za
1402         zx_t = 0.0         zx_t = 0.0
1403         za = 0.0         za = 0.0
1404         DO i = 1, klon         DO i = 1, klon
# Line 1461  contains Line 1406  contains
1406            zx_t = zx_t + (rain_con(i)+ &            zx_t = zx_t + (rain_con(i)+ &
1407                 snow_con(i))*airephy(i)/REAL(klon)                 snow_con(i))*airephy(i)/REAL(klon)
1408         ENDDO         ENDDO
1409         zx_t = zx_t/za*dtime         zx_t = zx_t/za*pdtphys
1410         WRITE(lunout, *)"Precip=", zx_t         print *,"Precip=", zx_t
1411      ENDIF      ENDIF
1412      IF (zx_ajustq) THEN      IF (zx_ajustq) THEN
1413         DO i = 1, klon         DO i = 1, klon
# Line 1475  contains Line 1420  contains
1420            ENDDO            ENDDO
1421         ENDDO         ENDDO
1422         DO i = 1, klon         DO i = 1, klon
1423            z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*dtime) &            z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*pdtphys) &
1424                 /z_apres(i)                 /z_apres(i)
1425         ENDDO         ENDDO
1426         DO k = 1, llm         DO k = 1, llm
1427            DO i = 1, klon            DO i = 1, klon
1428               IF (z_factor(i).GT.(1.0+1.0E-08) .OR. &               IF (z_factor(i).GT.(1.0+1.0E-08) .OR. &
1429                    z_factor(i).LT.(1.0-1.0E-08)) THEN                    z_factor(i) < (1.0-1.0E-08)) THEN
1430                  q_seri(i, k) = q_seri(i, k) * z_factor(i)                  q_seri(i, k) = q_seri(i, k) * z_factor(i)
1431               ENDIF               ENDIF
1432            ENDDO            ENDDO
# Line 1491  contains Line 1436  contains
1436    
1437      ! Convection seche (thermiques ou ajustement)      ! Convection seche (thermiques ou ajustement)
1438    
1439      d_t_ajs(:, :)=0.      d_t_ajs=0.
1440      d_u_ajs(:, :)=0.      d_u_ajs=0.
1441      d_v_ajs(:, :)=0.      d_v_ajs=0.
1442      d_q_ajs(:, :)=0.      d_q_ajs=0.
1443      fm_therm(:, :)=0.      fm_therm=0.
1444      entr_therm(:, :)=0.      entr_therm=0.
1445    
1446      IF(prt_level>9)WRITE(lunout, *) &      IF(prt_level>9)print *, &
1447           'AVANT LA CONVECTION SECHE, iflag_thermals=' &           'AVANT LA CONVECTION SECHE, iflag_thermals=' &
1448           , iflag_thermals, '   nsplit_thermals=', nsplit_thermals           , iflag_thermals, '   nsplit_thermals=', nsplit_thermals
1449      if(iflag_thermals.lt.0) then      if(iflag_thermals < 0) then
1450         !  Rien         !  Rien
1451         IF(prt_level>9)WRITE(lunout, *)'pas de convection'         IF(prt_level>9)print *,'pas de convection'
1452      else if(iflag_thermals == 0) then      else if(iflag_thermals == 0) then
1453         !  Ajustement sec         !  Ajustement sec
1454         IF(prt_level>9)WRITE(lunout, *)'ajsec'         IF(prt_level>9)print *,'ajsec'
1455         CALL ajsec(paprs, pplay, t_seri, q_seri, d_t_ajs, d_q_ajs)         CALL ajsec(paprs, pplay, t_seri, q_seri, d_t_ajs, d_q_ajs)
1456         t_seri(:, :) = t_seri(:, :) + d_t_ajs(:, :)         t_seri = t_seri + d_t_ajs
1457         q_seri(:, :) = q_seri(:, :) + d_q_ajs(:, :)         q_seri = q_seri + d_q_ajs
1458      else      else
1459         !  Thermiques         !  Thermiques
1460         IF(prt_level>9)WRITE(lunout, *)'JUSTE AVANT, iflag_thermals=' &         IF(prt_level>9)print *,'JUSTE AVANT, iflag_thermals=' &
1461              , iflag_thermals, '   nsplit_thermals=', nsplit_thermals              , iflag_thermals, '   nsplit_thermals=', nsplit_thermals
1462         call calltherm(pdtphys &         call calltherm(pdtphys &
1463              , pplay, paprs, pphi &              , pplay, paprs, pphi &
# Line 1523  contains Line 1468  contains
1468    
1469      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1470         ztit='after dry_adjust'         ztit='after dry_adjust'
1471         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1472              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1473              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1474      END IF      END IF
1475    
# Line 1560  contains Line 1505  contains
1505         !   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
1506         !   relaxation des ratqs         !   relaxation des ratqs
1507         facteur=exp(-pdtphys*facttemps)         facteur=exp(-pdtphys*facttemps)
1508         ratqs(:, :)=max(ratqs(:, :)*facteur, ratqss(:, :))         ratqs=max(ratqs*facteur, ratqss)
1509         ratqs(:, :)=max(ratqs(:, :), ratqsc(:, :))         ratqs=max(ratqs, ratqsc)
1510      else      else
1511         !   on ne prend que le ratqs stable pour fisrtilp         !   on ne prend que le ratqs stable pour fisrtilp
1512         ratqs(:, :)=ratqss(:, :)         ratqs=ratqss
1513      endif      endif
1514    
1515      ! Appeler le processus de condensation a grande echelle      ! Appeler le processus de condensation a grande echelle
1516      ! et le processus de precipitation      ! et le processus de precipitation
1517      CALL fisrtilp(dtime, paprs, pplay, &      CALL fisrtilp(pdtphys, paprs, pplay, &
1518           t_seri, q_seri, ptconv, ratqs, &           t_seri, q_seri, ptconv, ratqs, &
1519           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, &           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, &
1520           rain_lsc, snow_lsc, &           rain_lsc, snow_lsc, &
# Line 1590  contains Line 1535  contains
1535      ENDDO      ENDDO
1536      IF (check) THEN      IF (check) THEN
1537         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
1538         WRITE(lunout, *)"apresilp=", za         print *,"apresilp=", za
1539         zx_t = 0.0         zx_t = 0.0
1540         za = 0.0         za = 0.0
1541         DO i = 1, klon         DO i = 1, klon
# Line 1598  contains Line 1543  contains
1543            zx_t = zx_t + (rain_lsc(i) &            zx_t = zx_t + (rain_lsc(i) &
1544                 + snow_lsc(i))*airephy(i)/REAL(klon)                 + snow_lsc(i))*airephy(i)/REAL(klon)
1545         ENDDO         ENDDO
1546         zx_t = zx_t/za*dtime         zx_t = zx_t/za*pdtphys
1547         WRITE(lunout, *)"Precip=", zx_t         print *,"Precip=", zx_t
1548      ENDIF      ENDIF
1549    
1550      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1551         ztit='after fisrt'         ztit='after fisrt'
1552         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1553              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1554              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1555         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil &
1556              , zero_v, zero_v, zero_v, zero_v, zero_v &              , zero_v, zero_v, zero_v, zero_v, zero_v &
# Line 1626  contains Line 1571  contains
1571            rain_tiedtke=0.            rain_tiedtke=0.
1572            do k=1, llm            do k=1, llm
1573               do i=1, klon               do i=1, klon
1574                  if (d_q_con(i, k).lt.0.) then                  if (d_q_con(i, k) < 0.) then
1575                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &
1576                          *(paprs(i, k)-paprs(i, k+1))/rg                          *(paprs(i, k)-paprs(i, k+1))/rg
1577                  endif                  endif
# Line 1648  contains Line 1593  contains
1593         ENDDO         ENDDO
1594    
1595      ELSE IF (iflag_cldcon == 3) THEN      ELSE IF (iflag_cldcon == 3) THEN
1596         !  On prend pour les nuages convectifs le max du calcul de la         ! On prend pour les nuages convectifs le max du calcul de la
1597         !  convection et du calcul du pas de temps précédent diminué d'un facteur         ! convection et du calcul du pas de temps précédent diminué d'un facteur
1598         !  facttemps         ! facttemps
1599         facteur = pdtphys *facttemps         facteur = pdtphys *facttemps
1600         do k=1, llm         do k=1, llm
1601            do i=1, klon            do i=1, klon
# Line 1664  contains Line 1609  contains
1609         enddo         enddo
1610    
1611         !   On prend la somme des fractions nuageuses et des contenus en eau         !   On prend la somme des fractions nuageuses et des contenus en eau
1612         cldfra(:, :)=min(max(cldfra(:, :), rnebcon(:, :)), 1.)         cldfra=min(max(cldfra, rnebcon), 1.)
1613         cldliq(:, :)=cldliq(:, :)+rnebcon(:, :)*clwcon(:, :)         cldliq=cldliq+rnebcon*clwcon
1614    
1615      ENDIF      ENDIF
1616    
# Line 1692  contains Line 1637  contains
1637    
1638      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1639         ztit="after diagcld"         ztit="after diagcld"
1640         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1641              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1642              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1643      END IF      END IF
1644    
# Line 1709  contains Line 1654  contains
1654               zcor   = 1./(1.-retv*zx_qs)               zcor   = 1./(1.-retv*zx_qs)
1655               zx_qs  = zx_qs*zcor               zx_qs  = zx_qs*zcor
1656            ELSE            ELSE
1657               IF (zx_t.LT.t_coup) THEN               IF (zx_t < t_coup) THEN
1658                  zx_qs = qsats(zx_t)/pplay(i, k)                  zx_qs = qsats(zx_t)/pplay(i, k)
1659               ELSE               ELSE
1660                  zx_qs = qsatl(zx_t)/pplay(i, k)                  zx_qs = qsatl(zx_t)/pplay(i, k)
# Line 1723  contains Line 1668  contains
1668      !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)      !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)
1669      IF (ok_ade.OR.ok_aie) THEN      IF (ok_ade.OR.ok_aie) THEN
1670         ! Get sulfate aerosol distribution         ! Get sulfate aerosol distribution
1671         CALL readsulfate(rjourvrai, debut, sulfate)         CALL readsulfate(rdayvrai, firstcal, sulfate)
1672         CALL readsulfate_preind(rjourvrai, debut, sulfate_pi)         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)
1673    
1674         ! Calculate aerosol optical properties (Olivier Boucher)         ! Calculate aerosol optical properties (Olivier Boucher)
1675         CALL aeropt(pplay, paprs, t_seri, sulfate, rhcl, &         CALL aeropt(pplay, paprs, t_seri, sulfate, rhcl, &
# Line 1796  contains Line 1741  contains
1741      DO k = 1, llm      DO k = 1, llm
1742         DO i = 1, klon         DO i = 1, klon
1743            t_seri(i, k) = t_seri(i, k) &            t_seri(i, k) = t_seri(i, k) &
1744                 + (heat(i, k)-cool(i, k)) * dtime/86400.                 + (heat(i, k)-cool(i, k)) * pdtphys/86400.
1745         ENDDO         ENDDO
1746      ENDDO      ENDDO
1747    
1748      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1749         ztit='after rad'         ztit='after rad'
1750         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1751              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1752              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1753         call diagphy(airephy, ztit, ip_ebil &         call diagphy(airephy, ztit, ip_ebil &
1754              , topsw, toplw, solsw, sollw, zero_v &              , topsw, toplw, solsw, sollw, zero_v &
# Line 1831  contains Line 1776  contains
1776         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)         bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
1777      ENDDO      ENDDO
1778    
1779      !moddeblott(jan95)      !mod deb lott(jan95)
1780      ! Appeler le programme de parametrisation de l'orographie      ! Appeler le programme de parametrisation de l'orographie
1781      ! a l'echelle sous-maille:      ! a l'echelle sous-maille:
1782    
1783      IF (ok_orodr) THEN      IF (ok_orodr) THEN
   
1784         !  selection des points pour lesquels le shema est actif:         !  selection des points pour lesquels le shema est actif:
1785         igwd=0         igwd=0
1786         DO i=1, klon         DO i=1, klon
# Line 1848  contains Line 1792  contains
1792            ENDIF            ENDIF
1793         ENDDO         ENDDO
1794    
1795         CALL drag_noro(klon, llm, dtime, paprs, pplay, &         CALL drag_noro(klon, llm, pdtphys, paprs, pplay, &
1796              zmea, zstd, zsig, zgam, zthe, zpic, zval, &              zmea, zstd, zsig, zgam, zthe, zpic, zval, &
1797              igwd, idx, itest, &              igwd, idx, itest, &
1798              t_seri, u_seri, v_seri, &              t_seri, u_seri, v_seri, &
# Line 1863  contains Line 1807  contains
1807               v_seri(i, k) = v_seri(i, k) + d_v_oro(i, k)               v_seri(i, k) = v_seri(i, k) + d_v_oro(i, k)
1808            ENDDO            ENDDO
1809         ENDDO         ENDDO
1810        ENDIF
     ENDIF ! fin de test sur ok_orodr  
1811    
1812      IF (ok_orolf) THEN      IF (ok_orolf) THEN
1813    
# Line 1879  contains Line 1822  contains
1822            ENDIF            ENDIF
1823         ENDDO         ENDDO
1824    
1825         CALL lift_noro(klon, llm, dtime, paprs, pplay, &         CALL lift_noro(klon, llm, pdtphys, paprs, pplay, &
1826              rlat, zmea, zstd, zpic, &              rlat, zmea, zstd, zpic, &
1827              itest, &              itest, &
1828              t_seri, u_seri, v_seri, &              t_seri, u_seri, v_seri, &
# Line 1905  contains Line 1848  contains
1848      ENDDO      ENDDO
1849      DO k = 1, llm      DO k = 1, llm
1850         DO i = 1, klon         DO i = 1, klon
1851            zustrph(i)=zustrph(i)+(u_seri(i, k)-u(i, k))/dtime* &            zustrph(i)=zustrph(i)+(u_seri(i, k)-u(i, k))/pdtphys* &
1852                 (paprs(i, k)-paprs(i, k+1))/rg                 (paprs(i, k)-paprs(i, k+1))/rg
1853            zvstrph(i)=zvstrph(i)+(v_seri(i, k)-v(i, k))/dtime* &            zvstrph(i)=zvstrph(i)+(v_seri(i, k)-v(i, k))/pdtphys* &
1854                 (paprs(i, k)-paprs(i, k+1))/rg                 (paprs(i, k)-paprs(i, k+1))/rg
1855         ENDDO         ENDDO
1856      ENDDO      ENDDO
1857    
1858      !IM calcul composantes axiales du moment angulaire et couple des montagnes      !IM calcul composantes axiales du moment angulaire et couple des montagnes
1859    
1860      CALL aaam_bud (27, klon, llm, rjourvrai, gmtime, &      CALL aaam_bud (27, klon, llm, gmtime, &
1861           ra, rg, romega, &           ra, rg, romega, &
1862           rlat, rlon, pphis, &           rlat, rlon, pphis, &
1863           zustrdr, zustrli, zustrph, &           zustrdr, zustrli, zustrph, &
# Line 1924  contains Line 1867  contains
1867    
1868      IF (if_ebil >= 2) THEN      IF (if_ebil >= 2) THEN
1869         ztit='after orography'         ztit='after orography'
1870         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
1871              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1872              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1873      END IF      END IF
1874    
# Line 1933  contains Line 1876  contains
1876    
1877      !   Calcul  des tendances traceurs      !   Calcul  des tendances traceurs
1878    
1879      call phytrac(rnpb, itap,  julien,  gmtime, debut, lafin, nq-2, &      call phytrac(rnpb, itap, lmt_pas, julien,  gmtime, firstcal, lafin, nq-2, &
1880           dtime, u, v, t, paprs, pplay, &           pdtphys, u, v, t, paprs, pplay, pmfu,  pmfd,  pen_u,  pde_u,  pen_d, &
1881           pmfu,  pmfd,  pen_u,  pde_u,  pen_d,  pde_d, &           pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &
1882           ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, &           frac_impa,  frac_nucl, presnivs, pphis, pphi, albsol, rhcl, cldfra, &
1883           pctsrf, frac_impa,  frac_nucl, &           rneb,  diafra,  cldliq, itop_con, ibas_con, pmflxr, pmflxs, prfl, &
1884           presnivs, pphis, pphi, albsol, qx(1, 1, 1),  &           psfl, da, phi, mp, upwd, dnwd, tr_seri)
          rhcl, cldfra,  rneb,  diafra,  cldliq,  &  
          itop_con, ibas_con, pmflxr, pmflxs, &  
          prfl, psfl, da, phi, mp, upwd, dnwd, &  
          tr_seri)  
1885    
1886      IF (offline) THEN      IF (offline) THEN
1887    
# Line 1952  contains Line 1891  contains
1891              fm_therm, entr_therm, &              fm_therm, entr_therm, &
1892              ycoefh, yu1, yv1, ftsol, pctsrf, &              ycoefh, yu1, yv1, ftsol, pctsrf, &
1893              frac_impa, frac_nucl, &              frac_impa, frac_nucl, &
1894              pphis, airephy, dtime, itap)              pphis, airephy, pdtphys, itap)
1895    
1896      ENDIF      ENDIF
1897    
# Line 1977  contains Line 1916  contains
1916            d_t_ec(i, k)=0.5/ZRCPD &            d_t_ec(i, k)=0.5/ZRCPD &
1917                 *(u(i, k)**2+v(i, k)**2-u_seri(i, k)**2-v_seri(i, k)**2)                 *(u(i, k)**2+v(i, k)**2-u_seri(i, k)**2-v_seri(i, k)**2)
1918            t_seri(i, k)=t_seri(i, k)+d_t_ec(i, k)            t_seri(i, k)=t_seri(i, k)+d_t_ec(i, k)
1919            d_t_ec(i, k) = d_t_ec(i, k)/dtime            d_t_ec(i, k) = d_t_ec(i, k)/pdtphys
1920         END DO         END DO
1921      END DO      END DO
1922      !-jld ec_conser      !-jld ec_conser
1923      IF (if_ebil >= 1) THEN      IF (if_ebil >= 1) THEN
1924         ztit='after physic'         ztit='after physic'
1925         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtime &         CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, pdtphys &
1926              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs, pplay &              , t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, paprs &
1927              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
1928         !     Comme les tendances de la physique sont ajoute dans la dynamique,         !     Comme les tendances de la physique sont ajoute dans la dynamique,
1929         !     on devrait avoir que la variation d'entalpie par la dynamique         !     on devrait avoir que la variation d'entalpie par la dynamique
# Line 2002  contains Line 1941  contains
1941    
1942      !   SORTIES      !   SORTIES
1943    
     !IM Interpolation sur les niveaux de pression du NMC  
     call calcul_STDlev  
   
1944      !cc prw = eau precipitable      !cc prw = eau precipitable
1945      DO i = 1, klon      DO i = 1, klon
1946         prw(i) = 0.         prw(i) = 0.
# Line 2014  contains Line 1950  contains
1950         ENDDO         ENDDO
1951      ENDDO      ENDDO
1952    
     !IM initialisation + calculs divers diag AMIP2  
     call calcul_divers  
   
1953      ! Convertir les incrementations en tendances      ! Convertir les incrementations en tendances
1954    
1955      DO k = 1, llm      DO k = 1, llm
1956         DO i = 1, klon         DO i = 1, klon
1957            d_u(i, k) = ( u_seri(i, k) - u(i, k) ) / dtime            d_u(i, k) = ( u_seri(i, k) - u(i, k) ) / pdtphys
1958            d_v(i, k) = ( v_seri(i, k) - v(i, k) ) / dtime            d_v(i, k) = ( v_seri(i, k) - v(i, k) ) / pdtphys
1959            d_t(i, k) = ( t_seri(i, k)-t(i, k) ) / dtime            d_t(i, k) = ( t_seri(i, k)-t(i, k) ) / pdtphys
1960            d_qx(i, k, ivap) = ( q_seri(i, k) - qx(i, k, ivap) ) / dtime            d_qx(i, k, ivap) = ( q_seri(i, k) - qx(i, k, ivap) ) / pdtphys
1961            d_qx(i, k, iliq) = ( ql_seri(i, k) - qx(i, k, iliq) ) / dtime            d_qx(i, k, iliq) = ( ql_seri(i, k) - qx(i, k, iliq) ) / pdtphys
1962         ENDDO         ENDDO
1963      ENDDO      ENDDO
1964    
# Line 2033  contains Line 1966  contains
1966         DO iq = 3, nq         DO iq = 3, nq
1967            DO  k = 1, llm            DO  k = 1, llm
1968               DO  i = 1, klon               DO  i = 1, klon
1969                  d_qx(i, k, iq) = ( tr_seri(i, k, iq-2) - qx(i, k, iq) ) / dtime                  d_qx(i, k, iq) = (tr_seri(i, k, iq-2) - qx(i, k, iq)) / pdtphys
1970               ENDDO               ENDDO
1971            ENDDO            ENDDO
1972         ENDDO         ENDDO
# Line 2058  contains Line 1991  contains
1991    
1992      IF (lafin) THEN      IF (lafin) THEN
1993         itau_phy = itau_phy + itap         itau_phy = itau_phy + itap
1994         CALL phyredem ("restartphy.nc", dtime, radpas, &         CALL phyredem("restartphy.nc", rlat, rlon, pctsrf, ftsol, &
1995              rlat, rlon, pctsrf, ftsol, ftsoil, &              ftsoil, tslab, seaice, fqsurf, qsol, &
             tslab, seaice,  & !IM "slab" ocean  
             fqsurf, qsol, &  
1996              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, &              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, &
1997              solsw, sollwdown, dlw, &              solsw, sollwdown, dlw, &
1998              radsol, frugs, agesno, &              radsol, frugs, agesno, &
1999              zmea, zstd, zsig, zgam, zthe, zpic, zval, rugoro, &              zmea, zstd, zsig, zgam, zthe, zpic, zval, &
2000              t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)              t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)
2001      ENDIF      ENDIF
2002    
2003    contains    contains
2004    
     subroutine calcul_STDlev  
   
       !     From phylmd/calcul_STDlev.h, v 1.1 2005/05/25 13:10:09  
   
       !IM on initialise les champs en debut du jour ou du mois  
   
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, tsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, usumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, vsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, wsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, phisumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, qsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, rhsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, uvsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, vqsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, vTsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, wqsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, vphisumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, wTsumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, u2sumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, v2sumSTD)  
       CALL ini_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, &  
            tnondef, T2sumSTD)  
   
       !IM on interpole sur les niveaux STD de pression a chaque pas de  
       !temps de la physique  
   
       DO k=1, nlevSTD  
   
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               t_seri, tlevSTD(:, k))  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               u_seri, ulevSTD(:, k))  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               v_seri, vlevSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=paprs(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., zx_tmp_fi3d, rlevSTD(k), &  
               omega, wlevSTD(:, k))  
   
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zphi/RG, philevSTD(:, k))  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               qx(:, :, ivap), qlevSTD(:, k))  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_rh*100., rhlevSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=u_seri(i, l)*v_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, uvSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=v_seri(i, l)*q_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, vqSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=v_seri(i, l)*t_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, vTSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=omega(i, l)*qx(i, l, ivap)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, wqSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=v_seri(i, l)*zphi(i, l)/RG  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, vphiSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=omega(i, l)*t_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, wTSTD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=u_seri(i, l)*u_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, u2STD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=v_seri(i, l)*v_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, v2STD(:, k))  
   
          DO l=1, llm  
             DO i=1, klon  
                zx_tmp_fi3d(i, l)=t_seri(i, l)*t_seri(i, l)  
             ENDDO !i  
          ENDDO !l  
          CALL plevel(klon, llm, .true., pplay, rlevSTD(k), &  
               zx_tmp_fi3d, T2STD(:, k))  
   
       ENDDO !k=1, nlevSTD  
   
       !IM on somme les valeurs definies a chaque pas de temps de la physique ou  
       !IM toutes les 6 heures  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.TRUE.  
       CALL undefSTD(nlevSTD, itap, tlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, tsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, ulevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, usumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, vlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, vsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, wlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, wsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, philevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, phisumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, qlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, qsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, rhlevSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, rhsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, uvSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, uvsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, vqSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, vqsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, vTSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, vTsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, wqSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, wqsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, vphiSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, vphisumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, wTSTD, &  
            ecrit_hf, &  
            oknondef, tnondef, wTsumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, u2STD, &  
            ecrit_hf, &  
            oknondef, tnondef, u2sumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, v2STD, &  
            ecrit_hf, &  
            oknondef, tnondef, v2sumSTD)  
   
       oknondef(1:klon, 1:nlevSTD, 1:nout)=.FALSE.  
       CALL undefSTD(nlevSTD, itap, T2STD, &  
            ecrit_hf, &  
            oknondef, tnondef, T2sumSTD)  
   
       !IM on moyenne a la fin du jour ou du mois  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, tsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, usumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, vsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, wsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, phisumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, qsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, rhsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, uvsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, vqsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, vTsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, wqsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, vphisumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, wTsumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, u2sumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, v2sumSTD)  
   
       CALL moy_undefSTD(nlevSTD, itap, &  
            ecrit_day, ecrit_mth, ecrit_hf2mth, &  
            tnondef, T2sumSTD)  
   
       !IM interpolation a chaque pas de temps du SWup(clr) et  
       !SWdn(clr) a 200 hPa  
   
       CALL plevel(klon, klevp1, .true., paprs, 20000., &  
            swdn0, SWdn200clr)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            swdn, SWdn200)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            swup0, SWup200clr)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            swup, SWup200)  
   
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            lwdn0, LWdn200clr)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            lwdn, LWdn200)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            lwup0, LWup200clr)  
       CALL plevel(klon, klevp1, .false., paprs, 20000., &  
            lwup, LWup200)  
   
     end SUBROUTINE calcul_STDlev  
   
     !****************************************************  
   
     SUBROUTINE calcul_divers  
   
       ! From phylmd/calcul_divers.h, v 1.1 2005/05/25 13:10:09  
   
       ! initialisations diverses au "debut" du mois  
   
       IF(MOD(itap, ecrit_mth) == 1) THEN  
          DO i=1, klon  
             nday_rain(i)=0.  
          ENDDO  
       ENDIF  
   
       IF(MOD(itap, ecrit_day) == 0) THEN  
          !IM calcul total_rain, nday_rain  
          DO i = 1, klon  
             total_rain(i)=rain_fall(i)+snow_fall(i)    
             IF(total_rain(i).GT.0.) nday_rain(i)=nday_rain(i)+1.  
          ENDDO  
       ENDIF  
   
     End SUBROUTINE calcul_divers  
   
     !***********************************************  
   
2005      subroutine write_histday      subroutine write_histday
2006    
2007        !     From phylmd/write_histday.h, v 1.3 2005/05/25 13:10:09        use grid_change, only: gr_phy_write_3d
2008    
2009        if (ok_journe) THEN        !------------------------------------------------
2010    
2011          if (ok_journe) THEN
2012           ndex2d = 0           ndex2d = 0
2013           ndex3d = 0           ndex3d = 0
   
          ! Champs 2D:  
   
2014           itau_w = itau_phy + itap           itau_w = itau_phy + itap
2015             call histwrite(nid_day, "Sigma_O3_Royer", itau_w, gr_phy_write_3d(wo))
          !   FIN ECRITURE DES CHAMPS 3D  
2016    
2017           if (ok_sync) then           if (ok_sync) then
2018              call histsync(nid_day)              call histsync(nid_day)
2019           endif           endif
   
2020        ENDIF        ENDIF
2021    
2022      End subroutine write_histday      End subroutine write_histday
# Line 2484  contains Line 2057  contains
2057    
2058           ! Champs 2D:           ! Champs 2D:
2059    
2060           zsto = dtime * ecrit_ins           zsto = pdtphys * ecrit_ins
2061           zout = dtime * ecrit_ins           zout = pdtphys * ecrit_ins
2062           itau_w = itau_phy + itap           itau_w = itau_phy + itap
2063    
2064           i = NINT(zout/zsto)           i = NINT(zout/zsto)
2065           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)
2066           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "phis", itau_w, zx_tmp_2d)
2067    
2068           i = NINT(zout/zsto)           i = NINT(zout/zsto)
2069           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)
2070           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "aire", itau_w, zx_tmp_2d)
2071    
2072           DO i = 1, klon           DO i = 1, klon
2073              zx_tmp_fi2d(i) = paprs(i, 1)              zx_tmp_fi2d(i) = paprs(i, 1)
2074           ENDDO           ENDDO
2075           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
2076           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "psol", itau_w, zx_tmp_2d)
2077    
2078           DO i = 1, klon           DO i = 1, klon
2079              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)              zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
2080           ENDDO           ENDDO
2081           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
2082           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "precip", itau_w, zx_tmp_2d)
2083    
2084           DO i = 1, klon           DO i = 1, klon
2085              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)              zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
2086           ENDDO           ENDDO
2087           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
2088           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "plul", itau_w, zx_tmp_2d)
2089    
2090           DO i = 1, klon           DO i = 1, klon
2091              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)              zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
2092           ENDDO           ENDDO
2093           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
2094           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "pluc", itau_w, zx_tmp_2d)
2095    
2096           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zxtsol, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zxtsol, zx_tmp_2d)
2097           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "tsol", itau_w, zx_tmp_2d)
2098           !ccIM           !ccIM
2099           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zt2m, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zt2m, zx_tmp_2d)
2100           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "t2m", itau_w, zx_tmp_2d)
2101    
2102           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zq2m, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zq2m, zx_tmp_2d)
2103           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "q2m", itau_w, zx_tmp_2d)
2104    
2105           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zu10m, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zu10m, zx_tmp_2d)
2106           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "u10m", itau_w, zx_tmp_2d)
2107    
2108           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zv10m, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zv10m, zx_tmp_2d)
2109           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "v10m", itau_w, zx_tmp_2d)
2110    
2111           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), snow_fall, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), snow_fall, zx_tmp_2d)
2112           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "snow", itau_w, zx_tmp_2d)
2113    
2114           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), cdragm, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), cdragm, zx_tmp_2d)
2115           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "cdrm", itau_w, zx_tmp_2d)
2116    
2117           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), cdragh, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), cdragh, zx_tmp_2d)
2118           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "cdrh", itau_w, zx_tmp_2d)
2119    
2120           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), toplw, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), toplw, zx_tmp_2d)
2121           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "topl", itau_w, zx_tmp_2d)
2122    
2123           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), evap, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), evap, zx_tmp_2d)
2124           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "evap", itau_w, zx_tmp_2d)
2125    
2126           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), solsw, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), solsw, zx_tmp_2d)
2127           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "sols", itau_w, zx_tmp_2d)
2128    
2129           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sollw, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sollw, zx_tmp_2d)
2130           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "soll", itau_w, zx_tmp_2d)
2131    
2132           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sollwdown, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sollwdown, zx_tmp_2d)
2133           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "solldown", itau_w, zx_tmp_2d)
               ndex2d)  
2134    
2135           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), bils, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), bils, zx_tmp_2d)
2136           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "bils", itau_w, zx_tmp_2d)
2137    
2138           zx_tmp_fi2d(1:klon)=-1*sens(1:klon)           zx_tmp_fi2d(1:klon)=-1*sens(1:klon)
2139           !     CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sens, zx_tmp_2d)           !     CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), sens, zx_tmp_2d)
2140           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
2141           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "sens", itau_w, zx_tmp_2d)
2142    
2143           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), fder, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), fder, zx_tmp_2d)
2144           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "fder", itau_w, zx_tmp_2d)
2145    
2146           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_oce), zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_oce), zx_tmp_2d)
2147           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdfo", itau_w, zx_tmp_2d)
               ndex2d)  
2148    
2149           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_ter), zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_ter), zx_tmp_2d)
2150           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdft", itau_w, zx_tmp_2d)
               ndex2d)  
2151    
2152           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_lic), zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_lic), zx_tmp_2d)
2153           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdfg", itau_w, zx_tmp_2d)
               ndex2d)  
2154    
2155           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_sic), zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), d_ts(1, is_sic), zx_tmp_2d)
2156           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "dtsvdfi", itau_w, zx_tmp_2d)
               ndex2d)  
2157    
2158           DO nsrf = 1, nbsrf           DO nsrf = 1, nbsrf
2159              !XXX              !XXX
2160              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)*100.              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)*100.
2161              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
2162              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "pourc_"//clnsurf(nsrf), itau_w, &
2163                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2164    
2165              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)
2166              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
2167              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "fract_"//clnsurf(nsrf), itau_w, &
2168                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2169    
2170              zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)
2171              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
2172              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "sens_"//clnsurf(nsrf), itau_w, &
2173                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2174    
2175              zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)
2176              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
2177              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "lat_"//clnsurf(nsrf), itau_w, &
2178                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2179    
2180              zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
2181              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
2182              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tsol_"//clnsurf(nsrf), itau_w, &
2183                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2184    
2185              zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
2186              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
2187              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "taux_"//clnsurf(nsrf), itau_w, &
2188                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2189    
2190              zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)              zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
2191              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
2192              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "tauy_"//clnsurf(nsrf), itau_w, &
2193                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2194    
2195              zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
2196              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
2197              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "rugs_"//clnsurf(nsrf), itau_w, &
2198                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2199    
2200              zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)              zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)
2201              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)              CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zx_tmp_fi2d, zx_tmp_2d)
2202              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &              CALL histwrite(nid_ins, "albe_"//clnsurf(nsrf), itau_w, &
2203                   zx_tmp_2d, iim*(jjm + 1), ndex2d)                   zx_tmp_2d)
2204    
2205           END DO           END DO
2206           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), albsol, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), albsol, zx_tmp_2d)
2207           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "albs", itau_w, zx_tmp_2d)
2208           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), albsollw, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), albsollw, zx_tmp_2d)
2209           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "albslw", itau_w, zx_tmp_2d)
2210    
2211           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zxrugs, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), zxrugs, zx_tmp_2d)
2212           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "rugs", itau_w, zx_tmp_2d)
2213    
2214           !IM cf. AM 081204 BEG           !IM cf. AM 081204 BEG
2215    
2216           !HBTM2           !HBTM2
2217    
2218           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_pblh, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_pblh, zx_tmp_2d)
2219           CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "s_pblh", itau_w, zx_tmp_2d)
2220    
2221           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_pblt, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_pblt, zx_tmp_2d)
2222           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "s_pblt", itau_w, zx_tmp_2d)
2223    
2224           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_lcl, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_lcl, zx_tmp_2d)
2225           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d, iim*(jjm + 1), ndex2d)           CALL histwrite(nid_ins, "s_lcl", itau_w, zx_tmp_2d)
2226    
2227           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_capCL, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_capCL, zx_tmp_2d)
2228           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_capCL", itau_w, zx_tmp_2d)
               ndex2d)  
2229    
2230           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_oliqCL, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_oliqCL, zx_tmp_2d)
2231           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_oliqCL", itau_w, zx_tmp_2d)
               ndex2d)  
2232    
2233           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_cteiCL, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_cteiCL, zx_tmp_2d)
2234           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_cteiCL", itau_w, zx_tmp_2d)
               ndex2d)  
2235    
2236           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_therm, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_therm, zx_tmp_2d)
2237           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_therm", itau_w, zx_tmp_2d)
               ndex2d)  
2238    
2239           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb1, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb1, zx_tmp_2d)
2240           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_trmb1", itau_w, zx_tmp_2d)
               ndex2d)  
2241    
2242           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb2, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb2, zx_tmp_2d)
2243           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_trmb2", itau_w, zx_tmp_2d)
               ndex2d)  
2244    
2245           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb3, zx_tmp_2d)           CALL gr_fi_ecrit(1, klon, iim, (jjm + 1), s_trmb3, zx_tmp_2d)
2246           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d, iim*(jjm + 1), &           CALL histwrite(nid_ins, "s_trmb3", itau_w, zx_tmp_2d)
               ndex2d)  
2247    
2248           !IM cf. AM 081204 END           !IM cf. AM 081204 END
2249    
2250           ! Champs 3D:           ! Champs 3D:
2251    
2252           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), t_seri, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), t_seri, zx_tmp_3d)
2253           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d, &           CALL histwrite(nid_ins, "temp", itau_w, zx_tmp_3d)
               iim*(jjm + 1)*llm, ndex3d)  
2254    
2255           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), u_seri, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), u_seri, zx_tmp_3d)
2256           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d, &           CALL histwrite(nid_ins, "vitu", itau_w, zx_tmp_3d)
               iim*(jjm + 1)*llm, ndex3d)  
2257    
2258           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), v_seri, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), v_seri, zx_tmp_3d)
2259           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d, &           CALL histwrite(nid_ins, "vitv", itau_w, zx_tmp_3d)
               iim*(jjm + 1)*llm, ndex3d)  
2260    
2261           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), zphi, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), zphi, zx_tmp_3d)
2262           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d, &           CALL histwrite(nid_ins, "geop", itau_w, zx_tmp_3d)
               iim*(jjm + 1)*llm, ndex3d)  
2263    
2264           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), pplay, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), pplay, zx_tmp_3d)
2265           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d, &           CALL histwrite(nid_ins, "pres", itau_w, zx_tmp_3d)
               iim*(jjm + 1)*llm, ndex3d)  
2266    
2267           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), d_t_vdf, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), d_t_vdf, zx_tmp_3d)
2268           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d, &           CALL histwrite(nid_ins, "dtvdf", itau_w, zx_tmp_3d)
               iim*(jjm + 1)*llm, ndex3d)  
2269    
2270           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), d_q_vdf, zx_tmp_3d)           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), d_q_vdf, zx_tmp_3d)
2271           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d, &           CALL histwrite(nid_ins, "dqvdf", itau_w, zx_tmp_3d)
               iim*(jjm + 1)*llm, ndex3d)  
2272    
2273           if (ok_sync) then           if (ok_sync) then
2274              call histsync(nid_ins)              call histsync(nid_ins)
# Line 2737  contains Line 2291  contains
2291        ! Champs 3D:        ! Champs 3D:
2292    
2293        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), t_seri, zx_tmp_3d)        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), t_seri, zx_tmp_3d)
2294        CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d, &        CALL histwrite(nid_hf3d, "temp", itau_w, zx_tmp_3d)
            iim*(jjm + 1)*llm, ndex3d)  
2295    
2296        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), qx(1, 1, ivap), zx_tmp_3d)        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), qx(1, 1, ivap), zx_tmp_3d)
2297        CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d, &        CALL histwrite(nid_hf3d, "ovap", itau_w, zx_tmp_3d)
            iim*(jjm + 1)*llm, ndex3d)  
2298    
2299        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), u_seri, zx_tmp_3d)        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), u_seri, zx_tmp_3d)
2300        CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d, &        CALL histwrite(nid_hf3d, "vitu", itau_w, zx_tmp_3d)
            iim*(jjm + 1)*llm, ndex3d)  
2301    
2302        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), v_seri, zx_tmp_3d)        CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), v_seri, zx_tmp_3d)
2303        CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d, &        CALL histwrite(nid_hf3d, "vitv", itau_w, zx_tmp_3d)
            iim*(jjm + 1)*llm, ndex3d)  
2304    
2305        if (nbtr >= 3) then        if (nbtr >= 3) then
2306           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), tr_seri(1, 1, 3), &           CALL gr_fi_ecrit(llm, klon, iim, (jjm + 1), tr_seri(1, 1, 3), &
2307                zx_tmp_3d)                zx_tmp_3d)
2308           CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d, iim*(jjm + 1)*llm, &           CALL histwrite(nid_hf3d, "O3", itau_w, zx_tmp_3d)
               ndex3d)  
2309        end if        end if
2310    
2311        if (ok_sync) then        if (ok_sync) then
Legend:
Removed from v.6  
changed lines
  Added in v.15
  ViewVC Help
Powered by ViewVC 1.1.21