/[lmdze]/trunk/libf/phylmd/physiq.f90
ViewVC logotype

Diff of /trunk/libf/phylmd/physiq.f90

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

revision 6 by guez, Tue Mar 4 14:00:42 2008 UTC revision 7 by guez, Mon Mar 31 12:24:17 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, clesphy0, 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    
# Line 58  contains Line 58  contains
58      ! Variables argument:      ! Variables argument:
59    
60      INTEGER nq ! input nombre de traceurs (y compris vapeur d'eau)      INTEGER nq ! input nombre de traceurs (y compris vapeur d'eau)
61      REAL rjourvrai ! input numero du jour de l'experience      REAL, intent(in):: rdayvrai ! input numero du jour de l'experience
62      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
63      REAL pdtphys ! input pas d'integration pour la physique (seconde)      REAL pdtphys ! input pas d'integration pour la physique (seconde)
64      LOGICAL, intent(in):: debut ! premier passage      LOGICAL, intent(in):: firstcal ! first call to "calfis"
65      logical, intent(in):: lafin ! dernier passage      logical, intent(in):: lafin ! dernier passage
66    
67      REAL, intent(in):: paprs(klon, llm+1)      REAL, intent(in):: paprs(klon, llm+1)
# Line 319  contains Line 319  contains
319      PARAMETER    ( longcles = 20 )      PARAMETER    ( longcles = 20 )
320      REAL clesphy0( longcles      )      REAL clesphy0( longcles      )
321    
     ! Variables quasi-arguments  
   
     REAL xjour  
     SAVE xjour  
   
322      ! Variables propres a la physique      ! Variables propres a la physique
323    
324      REAL, SAVE:: dtime ! pas temporel de la physique (s)      REAL, SAVE:: dtime ! pas temporel de la physique (s)
# Line 335  contains Line 330  contains
330      REAL radsol(klon)      REAL radsol(klon)
331      SAVE radsol               ! bilan radiatif au sol calcule par code radiatif      SAVE radsol               ! bilan radiatif au sol calcule par code radiatif
332    
333      INTEGER, SAVE:: itap ! compteur pour la physique      INTEGER, SAVE:: itap ! number of calls to "physiq"
334      REAL co2_ppm_etat0      REAL co2_ppm_etat0
335      REAL solaire_etat0      REAL solaire_etat0
336    
# Line 472  contains Line 467  contains
467    
468      INTEGER julien      INTEGER julien
469    
470      INTEGER, SAVE:: lmt_pas ! fréquence de mise à jour      INTEGER, SAVE:: lmt_pas ! number of time steps of "physics" per day
471      REAL pctsrf(klon, nbsrf)      REAL pctsrf(klon, nbsrf)
472      !IM      !IM
473      REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE      REAL pctsrf_new(klon, nbsrf) !pourcentage surfaces issus d'ORCHIDEE
# Line 500  contains Line 495  contains
495      EXTERNAL transp    ! transport total de l'eau et de l'energie      EXTERNAL transp    ! transport total de l'eau et de l'energie
496    
497      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
498      EXTERNAL undefSTD !somme les valeurs definies d'1 var a 1 niveau de pression  
499        EXTERNAL undefSTD
500        ! (somme les valeurs definies d'1 var a 1 niveau de pression)
501    
502      ! Variables locales      ! Variables locales
503    
# Line 802  contains Line 799  contains
799         END DO         END DO
800      END IF      END IF
801      ok_sync=.TRUE.      ok_sync=.TRUE.
802      IF (nq .LT. 2) THEN      IF (nq  <  2) THEN
803         abort_message = 'eaux vapeur et liquide sont indispensables'         abort_message = 'eaux vapeur et liquide sont indispensables'
804         CALL abort_gcm (modname, abort_message, 1)         CALL abort_gcm (modname, abort_message, 1)
805      ENDIF      ENDIF
806    
807      xjour = rjourvrai      test_firstcal: IF (firstcal) THEN
   
     test_debut: IF (debut) THEN  
808         !  initialiser         !  initialiser
809         u10m(:, :)=0.         u10m(:, :)=0.
810         v10m(:, :)=0.         v10m(:, :)=0.
# Line 932  contains Line 927  contains
927         ENDIF         ENDIF
928    
929         lmt_pas = NINT(86400. / dtime)  ! tous les jours         lmt_pas = NINT(86400. / dtime)  ! tous les jours
930         print *, 'La frequence de lecture surface est de ', lmt_pas         print *, 'Number of time steps of "physics" per day: ', lmt_pas
931    
932         ecrit_ins = NINT(ecrit_ins/dtime)         ecrit_ins = NINT(ecrit_ins/dtime)
933         ecrit_hf = NINT(ecrit_hf/dtime)         ecrit_hf = NINT(ecrit_hf/dtime)
# Line 964  contains Line 959  contains
959         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)         CALL ymds2ju(annee_ref, 1, int(day_ref), 0., date0)
960         !XXXPB Positionner date0 pour initialisation de ORCHIDEE         !XXXPB Positionner date0 pour initialisation de ORCHIDEE
961         WRITE(*, *) 'physiq date0 : ', date0         WRITE(*, *) 'physiq date0 : ', date0
962      ENDIF test_debut      ENDIF test_firstcal
963    
964      ! Mettre a zero des variables de sortie (pour securite)      ! Mettre a zero des variables de sortie (pour securite)
965    
# Line 1065  contains Line 1060  contains
1060    
1061      ! Incrementer le compteur de la physique      ! Incrementer le compteur de la physique
1062    
1063      itap   = itap + 1      itap = itap + 1
1064      julien = MOD(NINT(xjour), 360)      julien = MOD(NINT(rdayvrai), 360)
1065      if (julien == 0) julien = 360      if (julien == 0) julien = 360
1066    
1067      ! Mettre en action les conditions aux limites (albedo, sst, etc.).      ! Mettre en action les conditions aux limites (albedo, sst, etc.).
# Line 1164  contains Line 1159  contains
1159           fluxlat, rain_fall, snow_fall, &           fluxlat, rain_fall, snow_fall, &
1160           fsolsw, fsollw, sollwdown, fder, &           fsolsw, fsollw, sollwdown, fder, &
1161           rlon, rlat, cuphy, cvphy, frugs, &           rlon, rlat, cuphy, cvphy, frugs, &
1162           debut, lafin, agesno, rugoro, &           firstcal, lafin, agesno, rugoro, &
1163           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, &
1164           fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, &           fluxt, fluxq, fluxu, fluxv, cdragh, cdragm, &
1165           q2, dsens, devap, &           q2, dsens, devap, &
# Line 1282  contains Line 1277  contains
1277    
1278      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
1279         DO i = 1, klon         DO i = 1, klon
1280            IF (pctsrf(i, nsrf) .LT. epsfra) ftsol(i, nsrf) = zxtsol(i)            IF (pctsrf(i, nsrf)  <  epsfra) ftsol(i, nsrf) = zxtsol(i)
1281    
1282            IF (pctsrf(i, nsrf) .LT. epsfra) t2m(i, nsrf) = zt2m(i)            IF (pctsrf(i, nsrf)  <  epsfra) t2m(i, nsrf) = zt2m(i)
1283            IF (pctsrf(i, nsrf) .LT. epsfra) q2m(i, nsrf) = zq2m(i)            IF (pctsrf(i, nsrf)  <  epsfra) q2m(i, nsrf) = zq2m(i)
1284            IF (pctsrf(i, nsrf) .LT. epsfra) u10m(i, nsrf) = zu10m(i)            IF (pctsrf(i, nsrf)  <  epsfra) u10m(i, nsrf) = zu10m(i)
1285            IF (pctsrf(i, nsrf) .LT. epsfra) v10m(i, nsrf) = zv10m(i)            IF (pctsrf(i, nsrf)  <  epsfra) v10m(i, nsrf) = zv10m(i)
1286            IF (pctsrf(i, nsrf) .LT. epsfra) ffonte(i, nsrf) = zxffonte(i)            IF (pctsrf(i, nsrf)  <  epsfra) ffonte(i, nsrf) = zxffonte(i)
1287            IF (pctsrf(i, nsrf) .LT. epsfra)  &            IF (pctsrf(i, nsrf)  <  epsfra)  &
1288                 fqcalving(i, nsrf) = zxfqcalving(i)                 fqcalving(i, nsrf) = zxfqcalving(i)
1289            IF (pctsrf(i, nsrf) .LT. epsfra) pblh(i, nsrf)=s_pblh(i)            IF (pctsrf(i, nsrf)  <  epsfra) pblh(i, nsrf)=s_pblh(i)
1290            IF (pctsrf(i, nsrf) .LT. epsfra) plcl(i, nsrf)=s_lcl(i)            IF (pctsrf(i, nsrf)  <  epsfra) plcl(i, nsrf)=s_lcl(i)
1291            IF (pctsrf(i, nsrf) .LT. epsfra) capCL(i, nsrf)=s_capCL(i)            IF (pctsrf(i, nsrf)  <  epsfra) capCL(i, nsrf)=s_capCL(i)
1292            IF (pctsrf(i, nsrf) .LT. epsfra) oliqCL(i, nsrf)=s_oliqCL(i)            IF (pctsrf(i, nsrf)  <  epsfra) oliqCL(i, nsrf)=s_oliqCL(i)
1293            IF (pctsrf(i, nsrf) .LT. epsfra) cteiCL(i, nsrf)=s_cteiCL(i)            IF (pctsrf(i, nsrf)  <  epsfra) cteiCL(i, nsrf)=s_cteiCL(i)
1294            IF (pctsrf(i, nsrf) .LT. epsfra) pblT(i, nsrf)=s_pblT(i)            IF (pctsrf(i, nsrf)  <  epsfra) pblT(i, nsrf)=s_pblT(i)
1295            IF (pctsrf(i, nsrf) .LT. epsfra) therm(i, nsrf)=s_therm(i)            IF (pctsrf(i, nsrf)  <  epsfra) therm(i, nsrf)=s_therm(i)
1296            IF (pctsrf(i, nsrf) .LT. epsfra) trmb1(i, nsrf)=s_trmb1(i)            IF (pctsrf(i, nsrf)  <  epsfra) trmb1(i, nsrf)=s_trmb1(i)
1297            IF (pctsrf(i, nsrf) .LT. epsfra) trmb2(i, nsrf)=s_trmb2(i)            IF (pctsrf(i, nsrf)  <  epsfra) trmb2(i, nsrf)=s_trmb2(i)
1298            IF (pctsrf(i, nsrf) .LT. epsfra) trmb3(i, nsrf)=s_trmb3(i)            IF (pctsrf(i, nsrf)  <  epsfra) trmb3(i, nsrf)=s_trmb3(i)
1299         ENDDO         ENDDO
1300      ENDDO      ENDDO
1301    
# Line 1411  contains Line 1406  contains
1406                  zcor   = 1./(1.-retv*zx_qs)                  zcor   = 1./(1.-retv*zx_qs)
1407                  zx_qs  = zx_qs*zcor                  zx_qs  = zx_qs*zcor
1408               ELSE               ELSE
1409                  IF (zx_t.LT.t_coup) THEN                  IF (zx_t < t_coup) THEN
1410                     zx_qs = qsats(zx_t)/pplay(i, k)                     zx_qs = qsats(zx_t)/pplay(i, k)
1411                  ELSE                  ELSE
1412                     zx_qs = qsatl(zx_t)/pplay(i, k)                     zx_qs = qsatl(zx_t)/pplay(i, k)
# Line 1481  contains Line 1476  contains
1476         DO k = 1, llm         DO k = 1, llm
1477            DO i = 1, klon            DO i = 1, klon
1478               IF (z_factor(i).GT.(1.0+1.0E-08) .OR. &               IF (z_factor(i).GT.(1.0+1.0E-08) .OR. &
1479                    z_factor(i).LT.(1.0-1.0E-08)) THEN                    z_factor(i) < (1.0-1.0E-08)) THEN
1480                  q_seri(i, k) = q_seri(i, k) * z_factor(i)                  q_seri(i, k) = q_seri(i, k) * z_factor(i)
1481               ENDIF               ENDIF
1482            ENDDO            ENDDO
# Line 1501  contains Line 1496  contains
1496      IF(prt_level>9)WRITE(lunout, *) &      IF(prt_level>9)WRITE(lunout, *) &
1497           'AVANT LA CONVECTION SECHE, iflag_thermals=' &           'AVANT LA CONVECTION SECHE, iflag_thermals=' &
1498           , iflag_thermals, '   nsplit_thermals=', nsplit_thermals           , iflag_thermals, '   nsplit_thermals=', nsplit_thermals
1499      if(iflag_thermals.lt.0) then      if(iflag_thermals < 0) then
1500         !  Rien         !  Rien
1501         IF(prt_level>9)WRITE(lunout, *)'pas de convection'         IF(prt_level>9)WRITE(lunout, *)'pas de convection'
1502      else if(iflag_thermals == 0) then      else if(iflag_thermals == 0) then
# Line 1626  contains Line 1621  contains
1621            rain_tiedtke=0.            rain_tiedtke=0.
1622            do k=1, llm            do k=1, llm
1623               do i=1, klon               do i=1, klon
1624                  if (d_q_con(i, k).lt.0.) then                  if (d_q_con(i, k) < 0.) then
1625                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &                     rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i, k)/pdtphys &
1626                          *(paprs(i, k)-paprs(i, k+1))/rg                          *(paprs(i, k)-paprs(i, k+1))/rg
1627                  endif                  endif
# Line 1648  contains Line 1643  contains
1643         ENDDO         ENDDO
1644    
1645      ELSE IF (iflag_cldcon == 3) THEN      ELSE IF (iflag_cldcon == 3) THEN
1646         !  On prend pour les nuages convectifs le max du calcul de la         ! On prend pour les nuages convectifs le max du calcul de la
1647         !  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
1648         !  facttemps         ! facttemps
1649         facteur = pdtphys *facttemps         facteur = pdtphys *facttemps
1650         do k=1, llm         do k=1, llm
1651            do i=1, klon            do i=1, klon
# Line 1709  contains Line 1704  contains
1704               zcor   = 1./(1.-retv*zx_qs)               zcor   = 1./(1.-retv*zx_qs)
1705               zx_qs  = zx_qs*zcor               zx_qs  = zx_qs*zcor
1706            ELSE            ELSE
1707               IF (zx_t.LT.t_coup) THEN               IF (zx_t < t_coup) THEN
1708                  zx_qs = qsats(zx_t)/pplay(i, k)                  zx_qs = qsats(zx_t)/pplay(i, k)
1709               ELSE               ELSE
1710                  zx_qs = qsatl(zx_t)/pplay(i, k)                  zx_qs = qsatl(zx_t)/pplay(i, k)
# Line 1723  contains Line 1718  contains
1718      !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)      !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)
1719      IF (ok_ade.OR.ok_aie) THEN      IF (ok_ade.OR.ok_aie) THEN
1720         ! Get sulfate aerosol distribution         ! Get sulfate aerosol distribution
1721         CALL readsulfate(rjourvrai, debut, sulfate)         CALL readsulfate(rdayvrai, firstcal, sulfate)
1722         CALL readsulfate_preind(rjourvrai, debut, sulfate_pi)         CALL readsulfate_preind(rdayvrai, firstcal, sulfate_pi)
1723    
1724         ! Calculate aerosol optical properties (Olivier Boucher)         ! Calculate aerosol optical properties (Olivier Boucher)
1725         CALL aeropt(pplay, paprs, t_seri, sulfate, rhcl, &         CALL aeropt(pplay, paprs, t_seri, sulfate, rhcl, &
# Line 1914  contains Line 1909  contains
1909    
1910      !IM calcul composantes axiales du moment angulaire et couple des montagnes      !IM calcul composantes axiales du moment angulaire et couple des montagnes
1911    
1912      CALL aaam_bud (27, klon, llm, rjourvrai, gmtime, &      CALL aaam_bud (27, klon, llm, gmtime, &
1913           ra, rg, romega, &           ra, rg, romega, &
1914           rlat, rlon, pphis, &           rlat, rlon, pphis, &
1915           zustrdr, zustrli, zustrph, &           zustrdr, zustrli, zustrph, &
# Line 1933  contains Line 1928  contains
1928    
1929      !   Calcul  des tendances traceurs      !   Calcul  des tendances traceurs
1930    
1931      call phytrac(rnpb, itap,  julien,  gmtime, debut, lafin, nq-2, &      call phytrac(rnpb, itap, lmt_pas, julien,  gmtime, firstcal, lafin, nq-2, &
1932           dtime, u, v, t, paprs, pplay, &           dtime, u, v, t, paprs, pplay, &
1933           pmfu,  pmfd,  pen_u,  pde_u,  pen_d,  pde_d, &           pmfu,  pmfd,  pen_u,  pde_u,  pen_d,  pde_d, &
1934           ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, &           ycoefh, fm_therm, entr_therm, yu1, yv1, ftsol, &
# Line 2227  contains Line 2222  contains
2222    
2223        ENDDO !k=1, nlevSTD        ENDDO !k=1, nlevSTD
2224    
2225        !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
2226        !IM toutes les 6 heures        ! physique ou toutes les 6 heures
2227    
2228        oknondef(1:klon, 1:nlevSTD, 1:nout)=.TRUE.        oknondef(1:klon, 1:nlevSTD, 1:nout)=.TRUE.
2229        CALL undefSTD(nlevSTD, itap, tlevSTD, &        CALL undefSTD(nlevSTD, itap, tlevSTD, &
Legend:
Removed from v.6  
changed lines
  Added in v.7
  ViewVC Help
Powered by ViewVC 1.1.21