/[lmdze]/trunk/Sources/dyn3d/Guide/guide.f
ViewVC logotype

Diff of /trunk/Sources/dyn3d/Guide/guide.f

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

trunk/libf/dyn3d/guide.f90 revision 44 by guez, Wed Apr 13 12:29:18 2011 UTC trunk/dyn3d/guide.f revision 88 by guez, Tue Mar 11 15:09:02 2014 UTC
# Line 13  CONTAINS Line 13  CONTAINS
13    
14      ! Author: F.Hourdin      ! Author: F.Hourdin
15    
16      USE comconst, ONLY : cpp, daysec, dtvr, kappa      USE comconst, ONLY: cpp, daysec, dtvr, kappa
17      USE comgeom, ONLY : aire, rlatu, rlonv      USE comgeom, ONLY: aire, rlatu, rlonv
18      USE comvert, ONLY : ap, bp, preff, presnivs      USE conf_gcm_m, ONLY: day_step, iperiod
     USE conf_gcm_m, ONLY : day_step, iperiod  
19      use conf_guide_m, only: conf_guide, guide_u, guide_v, guide_t, guide_q, &      use conf_guide_m, only: conf_guide, guide_u, guide_v, guide_t, guide_q, &
20           guide_p, ncep, ini_anal, tau_min_u, tau_max_u, tau_min_v, tau_max_v, &           ncep, ini_anal, tau_min_u, tau_max_u, tau_min_v, tau_max_v, &
21           tau_min_t, tau_max_t, tau_min_q, tau_max_q, tau_min_p, tau_max_p, &           tau_min_t, tau_max_t, tau_min_q, tau_max_q, tau_min_p, tau_max_p, &
22           online           online
23      USE dimens_m, ONLY : jjm, llm      USE dimens_m, ONLY: iim, jjm, llm
24      USE exner_hyb_m, ONLY : exner_hyb      USE disvert_m, ONLY: ap, bp, preff, presnivs
25      USE inigrads_m, ONLY : inigrads      USE exner_hyb_m, ONLY: exner_hyb
26        USE inigrads_m, ONLY: inigrads
27        use massdair_m, only: massdair
28      use netcdf, only: nf90_nowrite, nf90_open, nf90_close, nf90_inq_dimid, &      use netcdf, only: nf90_nowrite, nf90_open, nf90_close, nf90_inq_dimid, &
29           nf90_inquire_dimension           nf90_inquire_dimension
30      use nr_util, only: pi      use nr_util, only: pi
31      USE paramet_m, ONLY : iip1, ip1jm, ip1jmp1, jjp1, llmp1      USE paramet_m, ONLY: iip1, ip1jm, ip1jmp1, jjp1, llmp1
32      USE q_sat_m, ONLY : q_sat      USE q_sat_m, ONLY: q_sat
33      USE serre, ONLY : clat, clon      use read_reanalyse_m, only: read_reanalyse
34        USE serre, ONLY: clat, clon
35      use tau2alpha_m, only: tau2alpha, dxdys      use tau2alpha_m, only: tau2alpha, dxdys
36    
37        INTEGER, INTENT(IN):: itau
38    
39      ! variables dynamiques      ! variables dynamiques
40      REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm) ! vents covariants      REAL ucov(ip1jmp1, llm), vcov(ip1jm, llm) ! vents covariants
41      REAL, intent(inout):: teta(ip1jmp1, llm) ! temperature potentielle      REAL, intent(inout):: teta(ip1jmp1, llm) ! temperature potentielle
42      REAL q(ip1jmp1, llm) ! temperature potentielle      REAL q(ip1jmp1, llm) ! temperature potentielle
43      REAL ps(ip1jmp1) ! pression au sol      REAL, intent(out):: masse(ip1jmp1, llm) ! masse d'air
44      REAL masse(ip1jmp1, llm) ! masse d'air      REAL, intent(in):: ps(:, :) ! (iim + 1, jjm + 1) pression au sol
45    
46        ! Local:
47    
48      ! variables dynamiques pour les reanalyses.      ! variables dynamiques pour les reanalyses.
49      REAL, save:: ucovrea1(ip1jmp1, llm), vcovrea1(ip1jm, llm) !vts cov reas      REAL, save:: ucovrea1(ip1jmp1, llm), vcovrea1(ip1jm, llm) !vts cov reas
50      REAL, save:: tetarea1(ip1jmp1, llm) ! temp pot reales      REAL, save:: tetarea1(ip1jmp1, llm) ! temp pot reales
51      REAL, save:: qrea1(ip1jmp1, llm) ! temp pot reales      REAL, save:: qrea1(ip1jmp1, llm) ! temp pot reales
     REAL, save:: psrea1(ip1jmp1) ! ps  
52      REAL, save:: ucovrea2(ip1jmp1, llm), vcovrea2(ip1jm, llm) !vts cov reas      REAL, save:: ucovrea2(ip1jmp1, llm), vcovrea2(ip1jm, llm) !vts cov reas
53      REAL, save:: tetarea2(ip1jmp1, llm) ! temp pot reales      REAL, save:: tetarea2(ip1jmp1, llm) ! temp pot reales
54      REAL, save:: qrea2(ip1jmp1, llm) ! temp pot reales      REAL, save:: qrea2(ip1jmp1, llm) ! temp pot reales
55      REAL, save:: masserea2(ip1jmp1, llm) ! masse      REAL, save:: masserea2(ip1jmp1, llm) ! masse
     REAL, save:: psrea2(ip1jmp1) ! ps  
56    
57      REAL, save:: alpha_q(ip1jmp1)      REAL, save:: alpha_q(ip1jmp1)
58      REAL, save:: alpha_t(ip1jmp1), alpha_p(ip1jmp1)      REAL, save:: alpha_t(ip1jmp1), alpha_p(ip1jmp1)
# Line 60  CONTAINS Line 64  CONTAINS
64      INTEGER ilon, ilat      INTEGER ilon, ilat
65      REAL factt, ztau(ip1jmp1)      REAL factt, ztau(ip1jmp1)
66    
     INTEGER, INTENT(IN):: itau  
67      INTEGER ij, l      INTEGER ij, l
68      INTEGER ncidpl, varidpl, status      INTEGER ncidpl, varidpl, status
69      INTEGER rcod, rid      INTEGER rcod, rid
# Line 68  CONTAINS Line 71  CONTAINS
71      INTEGER, SAVE:: nlev      INTEGER, SAVE:: nlev
72    
73      ! TEST SUR QSAT      ! TEST SUR QSAT
74      REAL p(ip1jmp1, llmp1), pk(ip1jmp1, llm), pks(ip1jmp1)      REAL p(iim + 1, jjm + 1, llmp1), pk(ip1jmp1, llm), pks(ip1jmp1)
75      REAL pkf(ip1jmp1, llm)      REAL pkf(ip1jmp1, llm)
76      REAL pres(ip1jmp1, llm)      REAL pres(ip1jmp1, llm)
77    
# Line 87  CONTAINS Line 90  CONTAINS
90    
91      ! calcul de l'humidite saturante      ! calcul de l'humidite saturante
92    
93      forall (l = 1: llm + 1) p(:, l) = ap(l) + bp(l) * ps      forall (l = 1: llm + 1) p(:, :, l) = ap(l) + bp(l) * ps
94      CALL massdair(p, masse)      CALL massdair(p, masse)
95      CALL exner_hyb(ps, p, pks, pk, pkf)      CALL exner_hyb(ps, p, pks, pk, pkf)
96      tnat(:, :) = pk(:, :)*teta(:, :)/cpp      tnat(:, :) = pk(:, :)*teta(:, :)/cpp
# Line 181  CONTAINS Line 184  CONTAINS
184         rcod = nf90_close(ncidpl)         rcod = nf90_close(ncidpl)
185         ! Lecture du premier etat des reanalyses.         ! Lecture du premier etat des reanalyses.
186         CALL read_reanalyse(1, ps, ucovrea2, vcovrea2, tetarea2, qrea2, &         CALL read_reanalyse(1, ps, ucovrea2, vcovrea2, tetarea2, qrea2, &
187              masserea2, psrea2, 1, nlev)              masserea2, nlev)
188         qrea2(:, :) = max(qrea2(:, :), 0.1)         qrea2(:, :) = max(qrea2(:, :), 0.1)
189    
190         ! Debut de l'integration temporelle:         ! Debut de l'integration temporelle:
# Line 211  CONTAINS Line 214  CONTAINS
214            step_rea = step_rea + 1            step_rea = step_rea + 1
215            itau_test = itau            itau_test = itau
216            CALL read_reanalyse(step_rea, ps, ucovrea2, vcovrea2, tetarea2, &            CALL read_reanalyse(step_rea, ps, ucovrea2, vcovrea2, tetarea2, &
217                 qrea2, masserea2, psrea2, 1, nlev)                 qrea2, masserea2, nlev)
218            qrea2(:, :) = max(qrea2(:, :), 0.1)            qrea2(:, :) = max(qrea2(:, :), 0.1)
219            factt = dtvr*iperiod/daysec            factt = dtvr*iperiod/daysec
220            ztau(:) = factt/max(alpha_t(:), 1.E-10)            ztau(:) = factt/max(alpha_t(:), 1.E-10)
# Line 266  CONTAINS Line 269  CONTAINS
269         END DO         END DO
270      END IF      END IF
271    
     ! P  
     IF (guide_p) THEN  
        DO ij = 1, ip1jmp1  
           a = (1.-tau)*psrea1(ij) + tau*psrea2(ij)  
           ps(ij) = (1.-alpha_p(ij))*ps(ij) + alpha_p(ij)*a  
           IF (first .AND. ini_anal) ps(ij) = a  
        END DO  
        forall (l = 1: llm + 1) p(:, l) = ap(l) + bp(l) * ps  
        CALL massdair(p, masse)  
     END IF  
   
     ! q  
272      IF (guide_q) THEN      IF (guide_q) THEN
273         DO l = 1, llm         DO l = 1, llm
274            DO ij = 1, ip1jmp1            DO ij = 1, ip1jmp1
Legend:
Removed from v.44  
changed lines
  Added in v.88
  ViewVC Help
Powered by ViewVC 1.1.21