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

Diff of /trunk/phylmd/physiq.f

Parent Directory | Revision Log | View Patch Patch

-revision 6 by guez,
Tue Mar  4 14:00:42 2008 UTC
+revision 12 by guez,
Mon Jul 21 16:05:07 2008 UTC
 Line 9 
 module physiq_m
  contains
-   SUBROUTINE physiq (nq, debut, lafin, rjourvrai, gmtime, pdtphys, paprs, &
+   SUBROUTINE physiq(nq, firstcal, lafin, rdayvrai, gmtime, pdtphys, paprs, &
         pplay, pphi, pphis, presnivs, clesphy0, u, v, t, qx, omega, d_u, d_v, &
         d_t, d_qx, d_ps, dudyn, PVteta)
 Line 32 
 contains
      use dimsoil, only: nsoilmx
      use temps, only: itau_phy, day_ref, annee_ref, itaufin
      use clesphys, only: ecrit_hf, ecrit_hf2mth, &
-          ecrit_ins, iflag_con, ok_orolf, ok_orodr, ecrit_mth, ecrit_day, &
+          ecrit_ins, ecrit_mth, ecrit_day, &
-          nbapp_rad, cycle_diurne, cdmmax, cdhmax, &
+          cdmmax, cdhmax, &
-          co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, new_oliq, &
+          co2_ppm, ecrit_reg, ecrit_tra, ksta, ksta_ter, &
-          ok_kzmin, soil_model
+          ok_kzmin
-     use iniprint, only: lunout, prt_level
+     use clesphys2, only: iflag_con, ok_orolf, ok_orodr, nbapp_rad, &
+          cycle_diurne, new_oliq, soil_model
+     use iniprint, only: prt_level
      use abort_gcm_m, only: abort_gcm
      use YOMCST, only: rcpd, rtt, rlvtt, rg, ra, rsigma, retv, romega
      use comgeomphy
-Line 58 
 contains
+Line 60 
 contains
      ! Variables argument:
      INTEGER nq ! input nombre de traceurs (y compris vapeur d'eau)
-     REAL rjourvrai ! input numero du jour de l'experience
+     REAL, intent(in):: rdayvrai ! input numero du jour de l'experience
      REAL, intent(in):: gmtime ! heure de la journée en fraction de jour
-     REAL pdtphys ! input pas d'integration pour la physique (seconde)
+     REAL, intent(in):: pdtphys ! pas d'integration pour la physique (seconde)
-     LOGICAL, intent(in):: debut ! premier passage
+     LOGICAL, intent(in):: firstcal ! first call to "calfis"
      logical, intent(in):: lafin ! dernier passage
      REAL, intent(in):: paprs(klon, llm+1)
      ! (pression pour chaque inter-couche, en Pa)
-     REAL pplay(klon, llm)
+     REAL, intent(in):: pplay(klon, llm)
      ! (input pression pour le mileu de chaque couche (en Pa))
      REAL pphi(klon, llm)
-Line 82 
 contains
+Line 84 
 contains
      REAL v(klon, llm)  ! input vitesse Y (de S a N) en m/s
      REAL t(klon, llm)  ! input temperature (K)
-     REAL qx(klon, llm, nq)
+     REAL, intent(in):: qx(klon, llm, nq)
-     ! (input humidite specifique (kg/kg) et d'autres traceurs)
+     ! (humidite specifique (kg/kg) et fractions massiques des autres traceurs)
      REAL omega(klon, llm)  ! input vitesse verticale en Pa/s
      REAL d_u(klon, llm)  ! output tendance physique de "u" (m/s/s)
-Line 112 
 contains
+Line 114 
 contains
      INTEGER, SAVE :: npas, nexca
      logical rnpb
      parameter(rnpb=.true.)
-     !      ocean = type de modele ocean a utiliser: force, slab, couple
-     character(len=6) ocean
+     character(len=6), save:: ocean
-     SAVE ocean
+     ! (type de modèle océan à utiliser: "force" ou "slab" mais pas "couple")
      logical ok_ocean
      SAVE ok_ocean
-Line 317 
 contains
+Line 319 
 contains
      INTEGER        longcles
      PARAMETER    ( longcles = 20 )
-     REAL clesphy0( longcles      )
+     REAL, intent(in):: clesphy0( longcles      )
-     ! Variables quasi-arguments
-     REAL xjour
-     SAVE xjour
      ! Variables propres a la physique
-     REAL, SAVE:: dtime ! pas temporel de la physique (s)
      INTEGER, save:: radpas
      ! (Radiative transfer computations are made every "radpas" call to
      ! "physiq".)
-Line 335 
 contains
+Line 330 
 contains
      REAL radsol(klon)
      SAVE radsol               ! bilan radiatif au sol calcule par code radiatif
-     INTEGER, SAVE:: itap ! compteur pour la physique
+     INTEGER, SAVE:: itap ! number of calls to "physiq"
-     REAL co2_ppm_etat0
-     REAL solaire_etat0
      REAL ftsol(klon, nbsrf)
      SAVE ftsol                  ! temperature du sol
-Line 472 
 contains
+Line 465 
 contains
      INTEGER julien
-     INTEGER, SAVE:: lmt_pas ! fréquence de mise à jour
+     INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day
      REAL pctsrf(klon, nbsrf)
      !IM
      REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE
-Line 500 
 contains
+Line 493 
 contains
      EXTERNAL transp    ! transport total de l'eau et de l'energie
      EXTERNAL ini_undefSTD  !initialise a 0 une variable a 1 niveau de pression
-     EXTERNAL undefSTD !somme les valeurs definies d'1 var a 1 niveau de pression
+     EXTERNAL undefSTD
+     ! (somme les valeurs definies d'1 var a 1 niveau de pression)
      ! Variables locales
-Line 675 
 contains
+Line 670 
 contains
      REAL d_tr(klon, llm, nbtr)
      REAL zx_rh(klon, llm)
-     INTEGER        length
-     PARAMETER    ( length = 100 )
-     REAL tabcntr0( length       )
      INTEGER ndex2d(iim*(jjm + 1)), ndex3d(iim*(jjm + 1)*llm)
      REAL zustrdr(klon), zvstrdr(klon)
-Line 802 
 contains
+Line 792 
 contains
         END DO
      END IF
      ok_sync=.TRUE.
-     IF (nq .LT. 2) THEN
+     IF (nq  <  2) THEN
         abort_message = 'eaux vapeur et liquide sont indispensables'
         CALL abort_gcm (modname, abort_message, 1)
      ENDIF
-     xjour = rjourvrai
+     test_firstcal: IF (firstcal) THEN
-     test_debut: IF (debut) THEN
         !  initialiser
         u10m(:, :)=0.
         v10m(:, :)=0.
-Line 863 
 contains
+Line 851 
 contains
         frugs = 0.
         itap = 0
         itaprad = 0
-        CALL phyetat0("startphy.nc", dtime, co2_ppm_etat0, solaire_etat0, &
+        CALL phyetat0("startphy.nc", pctsrf, ftsol, ftsoil, ocean, tslab, &
-             pctsrf, ftsol, ftsoil, &
+             seaice, fqsurf, qsol, fsnow, &
-             ocean, tslab, seaice, & !IM "slab" ocean
-             fqsurf, qsol, fsnow, &
              falbe, falblw, fevap, rain_fall, snow_fall, solsw, sollwdown, &
              dlw, radsol, frugs, agesno, clesphy0, &
-             zmea, zstd, zsig, zgam, zthe, zpic, zval, rugoro, tabcntr0, &
+             zmea, zstd, zsig, zgam, zthe, zpic, zval, rugoro, &
              t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon,  &
              run_off_lic_0)
         !   ATTENTION : il faudra a terme relire q2 dans l'etat initial
         q2(:, :, :)=1.e-8
-        radpas = NINT( 86400. / dtime / nbapp_rad)
+        radpas = NINT( 86400. / pdtphys / nbapp_rad)
         ! on remet le calendrier a zero
-Line 884 
 contains
+Line 870 
 contains
            itau_phy = 0
         ENDIF
-        PRINT*, 'cycle_diurne =', cycle_diurne
+        PRINT *, 'cycle_diurne = ', cycle_diurne
         IF(ocean.NE.'force ') THEN
            ok_ocean=.TRUE.
         ENDIF
-        CALL printflag( tabcntr0, radpas, ok_ocean, ok_oasis, ok_journe, &
+        CALL printflag(radpas, ok_ocean, ok_oasis, ok_journe, ok_instan, &
-             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
-        IF (dtime*REAL(radpas).GT.21600..AND.cycle_diurne) THEN
+        IF (pdtphys*REAL(radpas).GT.21600..AND.cycle_diurne) THEN
-           WRITE(lunout, *)'Nbre d appels au rayonnement insuffisant'
+           print *,'Nbre d appels au rayonnement insuffisant'
-           WRITE(lunout, *)"Au minimum 4 appels par jour si cycle diurne"
+           print *,"Au minimum 4 appels par jour si cycle diurne"
            abort_message='Nbre d appels au rayonnement insuffisant'
            call abort_gcm(modname, abort_message, 1)
         ENDIF
-        WRITE(lunout, *)"Clef pour la convection, iflag_con=", iflag_con
+        print *,"Clef pour la convection, iflag_con=", iflag_con
-        WRITE(lunout, *)"Clef pour le driver de la convection, ok_cvl=", &
+        print *,"Clef pour le driver de la convection, ok_cvl=", &
              ok_cvl
         ! Initialisation pour la convection de K.E. (sb):
         IF (iflag_con >= 3) THEN
-           WRITE(lunout, *)"*** Convection de Kerry Emanuel 4.3  "
+           print *,"*** Convection de Kerry Emanuel 4.3  "
            !IM15/11/02 rajout initialisation ibas_con, itop_con cf. SB =>BEG
            DO i = 1, klon
-Line 931 
 contains
+Line 910 
 contains
            CALL SUGWD(klon, llm, paprs, pplay)
         ENDIF
-        lmt_pas = NINT(86400. / dtime)  ! tous les jours
+        lmt_pas = NINT(86400. / pdtphys)  ! tous les jours
-        print *, 'La frequence de lecture surface est de ', lmt_pas
+        print *, 'Number of time steps of "physics" per day: ', lmt_pas
-        ecrit_ins = NINT(ecrit_ins/dtime)
+        ecrit_ins = NINT(ecrit_ins/pdtphys)
-        ecrit_hf = NINT(ecrit_hf/dtime)
+        ecrit_hf = NINT(ecrit_hf/pdtphys)
-        ecrit_day = NINT(ecrit_day/dtime)
+        ecrit_day = NINT(ecrit_day/pdtphys)
-        ecrit_mth = NINT(ecrit_mth/dtime)
+        ecrit_mth = NINT(ecrit_mth/pdtphys)
-        ecrit_tra = NINT(86400.*ecrit_tra/dtime)
+        ecrit_tra = NINT(86400.*ecrit_tra/pdtphys)
-        ecrit_reg = NINT(ecrit_reg/dtime)
+        ecrit_reg = NINT(ecrit_reg/pdtphys)
         ! Initialiser le couplage si necessaire
         npas = 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
-        write(lunout, *)'AVANT HIST IFLAG_CON=', iflag_con
+        print *,'AVANT HIST IFLAG_CON=', iflag_con
         !   Initialisation des sorties
-        call ini_histhf(dtime, presnivs, nid_hf, nid_hf3d)
+        call ini_histhf(pdtphys, presnivs, nid_hf, nid_hf3d)
-        call ini_histday(dtime, presnivs, ok_journe, nid_day)
+        call ini_histday(pdtphys, presnivs, ok_journe, nid_day)
-        call ini_histins(dtime, presnivs, ok_instan, nid_ins)
+        call ini_histins(pdtphys, presnivs, ok_instan, nid_ins)
         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
         !XXXPB Positionner date0 pour initialisation de ORCHIDEE
         WRITE(*, *) 'physiq date0 : ', date0
-     ENDIF test_debut
+     ENDIF test_firstcal
      ! Mettre a zero des variables de sortie (pour securite)
-Line 1018 
 contains
+Line 989 
 contains
      IF (if_ebil >= 1) THEN
         ztit='after dynamic'
-        CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtime &
+        CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, pdtphys &
-             , 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 &
              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
         !     Comme les tendances de la physique sont ajoute dans la dynamique,
         !     on devrait avoir que la variation d'entalpie par la dynamique
-Line 1037 
 contains
+Line 1008 
 contains
      IF (ancien_ok) THEN
         DO k = 1, llm
            DO i = 1, klon
-              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
-              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
            ENDDO
         ENDDO
      ELSE
-Line 1065 
 contains
+Line 1036 
 contains
      ! Incrementer le compteur de la physique
-     itap   = itap + 1
+     itap = itap + 1
-     julien = MOD(NINT(xjour), 360)
+     julien = MOD(NINT(rdayvrai), 360)
      if (julien == 0) julien = 360
      ! Mettre en action les conditions aux limites (albedo, sst, etc.).
-Line 1094 
 contains
+Line 1065 
 contains
      IF (if_ebil >= 2) THEN
         ztit='after reevap'
-        CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, dtime &
+        CALL diagetpq(airephy, ztit, ip_ebil, 2, 1, pdtphys &
-             , 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 &
              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
         call diagphy(airephy, ztit, ip_ebil &
              , zero_v, zero_v, zero_v, zero_v, zero_v &
-Line 1125 
 contains
+Line 1096 
 contains
      CALL orbite(REAL(julien), zlongi, dist)
      IF (cycle_diurne) THEN
-        zdtime = dtime * REAL(radpas)
+        zdtime = pdtphys * REAL(radpas)
         CALL zenang(zlongi, gmtime, zdtime, rmu0, fract)
      ELSE
         rmu0 = -999.999
-Line 1154 
 contains
+Line 1125 
 contains
      fder = dlw
-     CALL clmain(dtime, itap, date0, pctsrf, pctsrf_new, &
+     CALL clmain(pdtphys, itap, date0, pctsrf, pctsrf_new, &
           t_seri, q_seri, u_seri, v_seri, &
           julien, rmu0, co2_ppm,  &
           ok_veget, ocean, npas, nexca, ftsol, &
-Line 1164 
 contains
+Line 1135 
 contains
           fluxlat, rain_fall, snow_fall, &
           fsolsw, fsollw, sollwdown, fder, &
           rlon, rlat, cuphy, cvphy, frugs, &
-          debut, lafin, agesno, rugoro, &
+          firstcal, lafin, agesno, rugoro, &
           d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_ts, &
           fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, &
           q2, dsens, devap, &
-Line 1211 
 contains
+Line 1182 
 contains
      IF (if_ebil >= 2) THEN
         ztit='after clmain'
-        CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &
+        CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
-             , 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 &
              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
         call diagphy(airephy, ztit, ip_ebil &
              , zero_v, zero_v, zero_v, zero_v, sens &
-Line 1282 
 contains
+Line 1253 
 contains
      DO nsrf = 1, nbsrf
         DO i = 1, klon
-           IF (pctsrf(i, nsrf) .LT. epsfra) ftsol(i, nsrf) = zxtsol(i)
+           IF (pctsrf(i, nsrf)  <  epsfra) ftsol(i, nsrf) = zxtsol(i)
-           IF (pctsrf(i, nsrf) .LT. epsfra) t2m(i, nsrf) = zt2m(i)
+           IF (pctsrf(i, nsrf)  <  epsfra) t2m(i, nsrf) = zt2m(i)
-           IF (pctsrf(i, nsrf) .LT. epsfra) q2m(i, nsrf) = zq2m(i)
+           IF (pctsrf(i, nsrf)  <  epsfra) q2m(i, nsrf) = zq2m(i)
-           IF (pctsrf(i, nsrf) .LT. epsfra) u10m(i, nsrf) = zu10m(i)
+           IF (pctsrf(i, nsrf)  <  epsfra) u10m(i, nsrf) = zu10m(i)
-           IF (pctsrf(i, nsrf) .LT. epsfra) v10m(i, nsrf) = zv10m(i)
+           IF (pctsrf(i, nsrf)  <  epsfra) v10m(i, nsrf) = zv10m(i)
-           IF (pctsrf(i, nsrf) .LT. epsfra) ffonte(i, nsrf) = zxffonte(i)
+           IF (pctsrf(i, nsrf)  <  epsfra) ffonte(i, nsrf) = zxffonte(i)
-           IF (pctsrf(i, nsrf) .LT. epsfra)  &
+           IF (pctsrf(i, nsrf)  <  epsfra)  &
                 fqcalving(i, nsrf) = zxfqcalving(i)
-           IF (pctsrf(i, nsrf) .LT. epsfra) pblh(i, nsrf)=s_pblh(i)
+           IF (pctsrf(i, nsrf)  <  epsfra) pblh(i, nsrf)=s_pblh(i)
-           IF (pctsrf(i, nsrf) .LT. epsfra) plcl(i, nsrf)=s_lcl(i)
+           IF (pctsrf(i, nsrf)  <  epsfra) plcl(i, nsrf)=s_lcl(i)
-           IF (pctsrf(i, nsrf) .LT. epsfra) capCL(i, nsrf)=s_capCL(i)
+           IF (pctsrf(i, nsrf)  <  epsfra) capCL(i, nsrf)=s_capCL(i)
-           IF (pctsrf(i, nsrf) .LT. epsfra) oliqCL(i, nsrf)=s_oliqCL(i)
+           IF (pctsrf(i, nsrf)  <  epsfra) oliqCL(i, nsrf)=s_oliqCL(i)
-           IF (pctsrf(i, nsrf) .LT. epsfra) cteiCL(i, nsrf)=s_cteiCL(i)
+           IF (pctsrf(i, nsrf)  <  epsfra) cteiCL(i, nsrf)=s_cteiCL(i)
-           IF (pctsrf(i, nsrf) .LT. epsfra) pblT(i, nsrf)=s_pblT(i)
+           IF (pctsrf(i, nsrf)  <  epsfra) pblT(i, nsrf)=s_pblT(i)
-           IF (pctsrf(i, nsrf) .LT. epsfra) therm(i, nsrf)=s_therm(i)
+           IF (pctsrf(i, nsrf)  <  epsfra) therm(i, nsrf)=s_therm(i)
-           IF (pctsrf(i, nsrf) .LT. epsfra) trmb1(i, nsrf)=s_trmb1(i)
+           IF (pctsrf(i, nsrf)  <  epsfra) trmb1(i, nsrf)=s_trmb1(i)
-           IF (pctsrf(i, nsrf) .LT. epsfra) trmb2(i, nsrf)=s_trmb2(i)
+           IF (pctsrf(i, nsrf)  <  epsfra) trmb2(i, nsrf)=s_trmb2(i)
-           IF (pctsrf(i, nsrf) .LT. epsfra) trmb3(i, nsrf)=s_trmb3(i)
+           IF (pctsrf(i, nsrf)  <  epsfra) trmb3(i, nsrf)=s_trmb3(i)
         ENDDO
      ENDDO
-Line 1315 
 contains
+Line 1286 
 contains
      DO k = 1, llm
         DO i = 1, klon
            conv_q(i, k) = d_q_dyn(i, k)  &
-                + d_q_vdf(i, k)/dtime
+                + d_q_vdf(i, k)/pdtphys
            conv_t(i, k) = d_t_dyn(i, k)  &
-                + d_t_vdf(i, k)/dtime
+                + d_t_vdf(i, k)/pdtphys
         ENDDO
      ENDDO
      IF (check) THEN
         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
-        WRITE(lunout, *) "avantcon=", za
+        print *, "avantcon=", za
      ENDIF
      zx_ajustq = .FALSE.
      IF (iflag_con == 2) zx_ajustq=.TRUE.
-Line 1340 
 contains
+Line 1311 
 contains
      IF (iflag_con == 1) THEN
         stop 'reactiver le call conlmd dans physiq.F'
      ELSE IF (iflag_con == 2) THEN
-        CALL conflx(dtime, paprs, pplay, t_seri, q_seri, &
+        CALL conflx(pdtphys, paprs, pplay, t_seri, q_seri, &
              conv_t, conv_q, zxfluxq(1, 1), omega, &
              d_t_con, d_q_con, rain_con, snow_con, &
              pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
-Line 1363 
 contains
+Line 1334 
 contains
         IF (ok_cvl) THEN ! new driver for convectL
            CALL concvl (iflag_con, &
-                dtime, paprs, pplay, t_seri, q_seri, &
+                pdtphys, paprs, pplay, t_seri, q_seri, &
                 u_seri, v_seri, tr_seri, ntra, &
                 ema_work1, ema_work2, &
                 d_t_con, d_q_con, d_u_con, d_v_con, d_tr, &
-Line 1379 
 contains
+Line 1350 
 contains
         ELSE ! ok_cvl
            ! MAF conema3 ne contient pas les traceurs
-           CALL conema3 (dtime, &
+           CALL conema3 (pdtphys, &
                 paprs, pplay, t_seri, q_seri, &
                 u_seri, v_seri, tr_seri, ntra, &
                 ema_work1, ema_work2, &
-Line 1411 
 contains
+Line 1382 
 contains
                  zcor   = 1./(1.-retv*zx_qs)
                  zx_qs  = zx_qs*zcor
               ELSE
-                 IF (zx_t.LT.t_coup) THEN
+                 IF (zx_t < t_coup) THEN
                     zx_qs = qsats(zx_t)/pplay(i, k)
                  ELSE
                     zx_qs = qsatl(zx_t)/pplay(i, k)
-Line 1426 
 contains
+Line 1397 
 contains
         call clouds_gno &
              (klon, llm, q_seri, zqsat, clwcon0, ptconv, ratqsc, rnebcon0)
      ELSE
-        WRITE(lunout, *) "iflag_con non-prevu", iflag_con
+        print *, "iflag_con non-prevu", iflag_con
         stop 1
      ENDIF
-Line 1441 
 contains
+Line 1412 
 contains
      IF (if_ebil >= 2) THEN
         ztit='after convect'
-        CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &
+        CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
-             , 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 &
              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
         call diagphy(airephy, ztit, ip_ebil &
              , zero_v, zero_v, zero_v, zero_v, zero_v &
-Line 1453 
 contains
+Line 1424 
 contains
      IF (check) THEN
         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
-        WRITE(lunout, *)"aprescon=", za
+        print *,"aprescon=", za
         zx_t = 0.0
         za = 0.0
         DO i = 1, klon
-Line 1461 
 contains
+Line 1432 
 contains
            zx_t = zx_t + (rain_con(i)+ &
                 snow_con(i))*airephy(i)/REAL(klon)
         ENDDO
-        zx_t = zx_t/za*dtime
+        zx_t = zx_t/za*pdtphys
-        WRITE(lunout, *)"Precip=", zx_t
+        print *,"Precip=", zx_t
      ENDIF
      IF (zx_ajustq) THEN
         DO i = 1, klon
-Line 1475 
 contains
+Line 1446 
 contains
            ENDDO
         ENDDO
         DO i = 1, klon
-           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) &
                 /z_apres(i)
         ENDDO
         DO k = 1, llm
            DO i = 1, klon
               IF (z_factor(i).GT.(1.0+1.0E-08) .OR. &
-                   z_factor(i).LT.(1.0-1.0E-08)) THEN
+                   z_factor(i) < (1.0-1.0E-08)) THEN
                  q_seri(i, k) = q_seri(i, k) * z_factor(i)
               ENDIF
            ENDDO
-Line 1498 
 contains
+Line 1469 
 contains
      fm_therm(:, :)=0.
      entr_therm(:, :)=0.
-     IF(prt_level>9)WRITE(lunout, *) &
+     IF(prt_level>9)print *, &
           'AVANT LA CONVECTION SECHE, iflag_thermals=' &
           , iflag_thermals, '   nsplit_thermals=', nsplit_thermals
-     if(iflag_thermals.lt.0) then
+     if(iflag_thermals < 0) then
         !  Rien
-        IF(prt_level>9)WRITE(lunout, *)'pas de convection'
+        IF(prt_level>9)print *,'pas de convection'
      else if(iflag_thermals == 0) then
         !  Ajustement sec
-        IF(prt_level>9)WRITE(lunout, *)'ajsec'
+        IF(prt_level>9)print *,'ajsec'
         CALL ajsec(paprs, pplay, t_seri, q_seri, d_t_ajs, d_q_ajs)
         t_seri(:, :) = t_seri(:, :) + d_t_ajs(:, :)
         q_seri(:, :) = q_seri(:, :) + d_q_ajs(:, :)
      else
         !  Thermiques
-        IF(prt_level>9)WRITE(lunout, *)'JUSTE AVANT, iflag_thermals=' &
+        IF(prt_level>9)print *,'JUSTE AVANT, iflag_thermals=' &
              , iflag_thermals, '   nsplit_thermals=', nsplit_thermals
         call calltherm(pdtphys &
              , pplay, paprs, pphi &
-Line 1523 
 contains
+Line 1494 
 contains
      IF (if_ebil >= 2) THEN
         ztit='after dry_adjust'
-        CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &
+        CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
-             , 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 &
              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
      END IF
-Line 1569 
 contains
+Line 1540 
 contains
      ! Appeler le processus de condensation a grande echelle
      ! et le processus de precipitation
-     CALL fisrtilp(dtime, paprs, pplay, &
+     CALL fisrtilp(pdtphys, paprs, pplay, &
           t_seri, q_seri, ptconv, ratqs, &
           d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, &
           rain_lsc, snow_lsc, &
-Line 1590 
 contains
+Line 1561 
 contains
      ENDDO
      IF (check) THEN
         za = qcheck(klon, llm, paprs, q_seri, ql_seri, airephy)
-        WRITE(lunout, *)"apresilp=", za
+        print *,"apresilp=", za
         zx_t = 0.0
         za = 0.0
         DO i = 1, klon
-Line 1598 
 contains
+Line 1569 
 contains
            zx_t = zx_t + (rain_lsc(i) &
                 + snow_lsc(i))*airephy(i)/REAL(klon)
         ENDDO
-        zx_t = zx_t/za*dtime
+        zx_t = zx_t/za*pdtphys
-        WRITE(lunout, *)"Precip=", zx_t
+        print *,"Precip=", zx_t
      ENDIF
      IF (if_ebil >= 2) THEN
         ztit='after fisrt'
-        CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &
+        CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
-             , 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 &
              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
         call diagphy(airephy, ztit, ip_ebil &
              , zero_v, zero_v, zero_v, zero_v, zero_v &
-Line 1626 
 contains
+Line 1597 
 contains
            rain_tiedtke=0.
            do k=1, llm
               do i=1, klon
-                 if (d_q_con(i, k).lt.0.) then
+                 if (d_q_con(i, k) < 0.) then
                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &
                          *(paprs(i, k)-paprs(i, k+1))/rg
                  endif
-Line 1648 
 contains
+Line 1619 
 contains
         ENDDO
      ELSE IF (iflag_cldcon == 3) THEN
-        !  On prend pour les nuages convectifs le max du calcul de la
+        ! On prend pour les nuages convectifs le max du calcul de la
-        !  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
-        !  facttemps
+        ! facttemps
         facteur = pdtphys *facttemps
         do k=1, llm
            do i=1, klon
-Line 1692 
 contains
+Line 1663 
 contains
      IF (if_ebil >= 2) THEN
         ztit="after diagcld"
-        CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &
+        CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
-             , 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 &
              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
      END IF
-Line 1709 
 contains
+Line 1680 
 contains
               zcor   = 1./(1.-retv*zx_qs)
               zx_qs  = zx_qs*zcor
            ELSE
-              IF (zx_t.LT.t_coup) THEN
+              IF (zx_t < t_coup) THEN
                  zx_qs = qsats(zx_t)/pplay(i, k)
               ELSE
                  zx_qs = qsatl(zx_t)/pplay(i, k)
-Line 1723 
 contains
+Line 1694 
 contains
      !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)
      IF (ok_ade.OR.ok_aie) THEN
         ! Get sulfate aerosol distribution
-        CALL readsulfate(rjourvrai, debut, sulfate)
+        CALL readsulfate(rdayvrai, firstcal, sulfate)
-        CALL readsulfate_preind(rjourvrai, debut, sulfate_pi)
+        CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)
         ! Calculate aerosol optical properties (Olivier Boucher)
         CALL aeropt(pplay, paprs, t_seri, sulfate, rhcl, &
-Line 1796 
 contains
+Line 1767 
 contains
      DO k = 1, llm
         DO i = 1, klon
            t_seri(i, k) = t_seri(i, k) &
-                + (heat(i, k)-cool(i, k)) * dtime/86400.
+                + (heat(i, k)-cool(i, k)) * pdtphys/86400.
         ENDDO
      ENDDO
      IF (if_ebil >= 2) THEN
         ztit='after rad'
-        CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &
+        CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
-             , 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 &
              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
         call diagphy(airephy, ztit, ip_ebil &
              , topsw, toplw, solsw, sollw, zero_v &
-Line 1848 
 contains
+Line 1819 
 contains
            ENDIF
         ENDDO
-        CALL drag_noro(klon, llm, dtime, paprs, pplay, &
+        CALL drag_noro(klon, llm, pdtphys, paprs, pplay, &
              zmea, zstd, zsig, zgam, zthe, zpic, zval, &
              igwd, idx, itest, &
              t_seri, u_seri, v_seri, &
-Line 1879 
 contains
+Line 1850 
 contains
            ENDIF
         ENDDO
-        CALL lift_noro(klon, llm, dtime, paprs, pplay, &
+        CALL lift_noro(klon, llm, pdtphys, paprs, pplay, &
              rlat, zmea, zstd, zpic, &
              itest, &
              t_seri, u_seri, v_seri, &
-Line 1905 
 contains
+Line 1876 
 contains
      ENDDO
      DO k = 1, llm
         DO i = 1, klon
-           zustrph(i)=zustrph(i)+(u_seri(i, k)-u(i, k))/dtime* &
+           zustrph(i)=zustrph(i)+(u_seri(i, k)-u(i, k))/pdtphys* &
                 (paprs(i, k)-paprs(i, k+1))/rg
-           zvstrph(i)=zvstrph(i)+(v_seri(i, k)-v(i, k))/dtime* &
+           zvstrph(i)=zvstrph(i)+(v_seri(i, k)-v(i, k))/pdtphys* &
                 (paprs(i, k)-paprs(i, k+1))/rg
         ENDDO
      ENDDO
      !IM calcul composantes axiales du moment angulaire et couple des montagnes
-     CALL aaam_bud (27, klon, llm, rjourvrai, gmtime, &
+     CALL aaam_bud (27, klon, llm, gmtime, &
           ra, rg, romega, &
           rlat, rlon, pphis, &
           zustrdr, zustrli, zustrph, &
-Line 1924 
 contains
+Line 1895 
 contains
      IF (if_ebil >= 2) THEN
         ztit='after orography'
-        CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, dtime &
+        CALL diagetpq(airephy, ztit, ip_ebil, 2, 2, pdtphys &
-             , 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 &
              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
      END IF
-Line 1933 
 contains
+Line 1904 
 contains
      !   Calcul  des tendances traceurs
-     call phytrac(rnpb, itap,  julien,  gmtime, debut, lafin, nq-2, &
+     call phytrac(rnpb, itap, lmt_pas, julien,  gmtime, firstcal, lafin, nq-2, &
-          dtime, u, v, t, paprs, pplay, &
+          pdtphys, u, v, t, paprs, pplay, pmfu,  pmfd,  pen_u,  pde_u,  pen_d, &
-          pmfu,  pmfd,  pen_u,  pde_u,  pen_d,  pde_d, &
+          pde_d, ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, pctsrf, &
-          ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, &
+          frac_impa,  frac_nucl, presnivs, pphis, pphi, albsol, rhcl, cldfra, &
-          pctsrf, frac_impa,  frac_nucl, &
+          rneb,  diafra,  cldliq, itop_con, ibas_con, pmflxr, pmflxs, prfl, &
-          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)
      IF (offline) THEN
-Line 1952 
 contains
+Line 1919 
 contains
              fm_therm, entr_therm, &
              ycoefh, yu1, yv1, ftsol, pctsrf, &
              frac_impa, frac_nucl, &
-             pphis, airephy, dtime, itap)
+             pphis, airephy, pdtphys, itap)
      ENDIF
-Line 1977 
 contains
+Line 1944 
 contains
            d_t_ec(i, k)=0.5/ZRCPD &
                 *(u(i, k)**2+v(i, k)**2-u_seri(i, k)**2-v_seri(i, k)**2)
            t_seri(i, k)=t_seri(i, k)+d_t_ec(i, k)
-           d_t_ec(i, k) = d_t_ec(i, k)/dtime
+           d_t_ec(i, k) = d_t_ec(i, k)/pdtphys
         END DO
      END DO
      !-jld ec_conser
      IF (if_ebil >= 1) THEN
         ztit='after physic'
-        CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, dtime &
+        CALL diagetpq(airephy, ztit, ip_ebil, 1, 1, pdtphys &
-             , 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 &
              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
         !     Comme les tendances de la physique sont ajoute dans la dynamique,
         !     on devrait avoir que la variation d'entalpie par la dynamique
-Line 2021 
 contains
+Line 1988 
 contains
      DO k = 1, llm
         DO i = 1, klon
-           d_u(i, k) = ( u_seri(i, k) - u(i, k) ) / dtime
+           d_u(i, k) = ( u_seri(i, k) - u(i, k) ) / pdtphys
-           d_v(i, k) = ( v_seri(i, k) - v(i, k) ) / dtime
+           d_v(i, k) = ( v_seri(i, k) - v(i, k) ) / pdtphys
-           d_t(i, k) = ( t_seri(i, k)-t(i, k) ) / dtime
+           d_t(i, k) = ( t_seri(i, k)-t(i, k) ) / pdtphys
-           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
-           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
         ENDDO
      ENDDO
-Line 2033 
 contains
+Line 2000 
 contains
         DO iq = 3, nq
            DO  k = 1, llm
               DO  i = 1, klon
-                 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
               ENDDO
            ENDDO
         ENDDO
-Line 2058 
 contains
+Line 2025 
 contains
      IF (lafin) THEN
         itau_phy = itau_phy + itap
-        CALL phyredem ("restartphy.nc", dtime, radpas, &
+        CALL phyredem ("restartphy.nc", radpas, rlat, rlon, pctsrf, ftsol, &
-             rlat, rlon, pctsrf, ftsol, ftsoil, &
+             ftsoil, tslab, seaice, fqsurf, qsol, &
-             tslab, seaice,  & !IM "slab" ocean
-             fqsurf, qsol, &
              fsnow, falbe, falblw, fevap, rain_fall, snow_fall, &
              solsw, sollwdown, dlw, &
              radsol, frugs, agesno, &
-Line 2227 
 contains
+Line 2192 
 contains
        ENDDO !k=1, nlevSTD
-       !IM on somme les valeurs definies a chaque pas de temps de la physique ou
+       !IM on somme les valeurs definies a chaque pas de temps de la
-       !IM toutes les 6 heures
+       ! physique ou toutes les 6 heures
        oknondef(1:klon, 1:nlevSTD, 1:nout)=.TRUE.
        CALL undefSTD(nlevSTD, itap, tlevSTD, &
-Line 2484 
 contains
+Line 2449 
 contains
           ! Champs 2D:
-          zsto = dtime * ecrit_ins
+          zsto = pdtphys * ecrit_ins
-          zout = dtime * ecrit_ins
+          zout = pdtphys * ecrit_ins
           itau_w = itau_phy + itap
           i = NINT(zout/zsto)

 Legend:



Removed from v.6
 


changed lines


 
Added in v.12
 Legend:



Removed from v.6
 


changed lines


 
Added in v.12
-Removed from v.6
+Added in v.12

	ViewVC Help
Powered by ViewVC 1.1.21