/[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/dyn3d/guide.f revision 102 by guez, Tue Jul 15 13:43:24 2014 UTC trunk/dyn3d/Guide/guide.f revision 114 by guez, Fri Sep 19 11:41:35 2014 UTC
# Line 18  CONTAINS Line 18  CONTAINS
18      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           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, online
          online  
22      USE dimens_m, ONLY: iim, jjm, llm      USE dimens_m, ONLY: iim, jjm, llm
23      USE disvert_m, ONLY: ap, bp, preff, presnivs      USE disvert_m, ONLY: ap, bp, preff, presnivs
     use dump2d_m, only: dump2d  
24      USE exner_hyb_m, ONLY: exner_hyb      USE exner_hyb_m, ONLY: exner_hyb
25      USE inigrads_m, ONLY: inigrads      use netcdf, only: nf90_nowrite
26      use massdair_m, only: massdair      use netcdf95, only: nf95_close, nf95_inq_dimid, nf95_inquire_dimension, &
27      use netcdf, only: nf90_nowrite, nf90_close, nf90_inq_dimid           nf95_open
     use netcdf95, only: nf95_inquire_dimension, nf95_open  
28      use nr_util, only: pi      use nr_util, only: pi
29      USE paramet_m, ONLY: iip1, ip1jm, ip1jmp1, jjp1, llmp1      USE paramet_m, ONLY: iip1, ip1jmp1, jjp1, llmp1
30      USE q_sat_m, ONLY: q_sat      USE q_sat_m, ONLY: q_sat
31      use read_reanalyse_m, only: read_reanalyse      use read_reanalyse_m, only: read_reanalyse
32      USE serre, ONLY: clat, clon      USE serre, ONLY: clat, clon
33      use tau2alpha_m, only: tau2alpha, dxdys      use tau2alpha_m, only: tau2alpha
34        use writefield_m, only: writefield
35    
36      INTEGER, INTENT(IN):: itau      INTEGER, INTENT(IN):: itau
   
     ! variables dynamiques  
   
37      REAL, intent(inout):: ucov(:, :, :) ! (iim + 1, jjm + 1, llm) vent covariant      REAL, intent(inout):: ucov(:, :, :) ! (iim + 1, jjm + 1, llm) vent covariant
38      REAL, intent(inout):: vcov(:, :, :) ! (iim + 1, jjm, llm) ! vent covariant      REAL, intent(inout):: vcov(:, :, :) ! (iim + 1, jjm, llm) ! vent covariant
39    
40      REAL, intent(inout):: teta(iim + 1, jjm + 1, llm) ! température potentielle      REAL, intent(inout):: teta(:, :, :) ! (iim + 1, jjm + 1, llm)
41      REAL, intent(inout):: q(iim + 1, jjm + 1, llm)      ! température potentielle
42    
43        REAL, intent(inout):: q(:, :, :) ! (iim + 1, jjm + 1, llm)
44      REAL, intent(in):: ps(:, :) ! (iim + 1, jjm + 1) pression au sol      REAL, intent(in):: ps(:, :) ! (iim + 1, jjm + 1) pression au sol
45    
46      ! Local:      ! Local:
47    
48      ! variables dynamiques pour les reanalyses.      ! variables dynamiques pour les réanalyses
49    
50      REAL, save:: ucovrea1(iim + 1, jjm + 1, llm), vcovrea1(iim + 1, jjm, llm)      REAL, save:: ucovrea1(iim + 1, jjm + 1, llm), vcovrea1(iim + 1, jjm, llm)
51      ! vents covariants reanalyses      ! vents covariants reanalyses
# Line 64  CONTAINS Line 61  CONTAINS
61      REAL, save:: masserea2(ip1jmp1, llm) ! masse      REAL, save:: masserea2(ip1jmp1, llm) ! masse
62    
63      ! alpha determine la part des injections de donnees a chaque etape      ! alpha determine la part des injections de donnees a chaque etape
64      ! alpha=1 signifie pas d'injection      ! alpha=0 signifie pas d'injection
65      ! alpha=0 signifie injection totale      ! alpha=1 signifie injection totale
66      REAL, save:: alpha_q(iim + 1, jjm + 1)      REAL, save:: alpha_q(iim + 1, jjm + 1)
67      REAL, save:: alpha_t(iim + 1, jjm + 1), alpha_p(ip1jmp1)      REAL, save:: alpha_t(iim + 1, jjm + 1)
68      REAL, save:: alpha_u(iim + 1, jjm + 1), alpha_v(iim + 1, jjm)      REAL, save:: alpha_u(iim + 1, jjm + 1), alpha_v(iim + 1, jjm)
69    
70      INTEGER, save:: step_rea, count_no_rea      INTEGER, save:: step_rea, count_no_rea
71    
72      INTEGER ilon, ilat      INTEGER ilon, ilat
73      REAL factt ! pas de temps entre deux appels au guidage, en fraction de jour      REAL factt ! pas de temps entre deux appels au guidage, en fraction de jour
     real ztau(iim + 1, jjm + 1)  
74    
75      INTEGER ij, l      INTEGER ij, l
76      INTEGER ncidpl, status      INTEGER ncid, dimid
     INTEGER rcod, rid  
77      REAL tau      REAL tau
78      INTEGER, SAVE:: nlev      INTEGER, SAVE:: nlev
79    
80      ! TEST SUR QSAT      ! TEST SUR QSAT
81      REAL p(iim + 1, jjm + 1, llmp1)      REAL p(iim + 1, jjm + 1, llmp1)
82      real pk(iim + 1, jjm + 1, llm), pks(iim + 1, jjm + 1)      real pk(iim + 1, jjm + 1, llm), pks(iim + 1, jjm + 1)
   
83      REAL qsat(iim + 1, jjm + 1, llm)      REAL qsat(iim + 1, jjm + 1, llm)
84    
     INTEGER, parameter:: igrads = 2  
     REAL:: dtgrads = 100.  
   
85      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
86    
87      PRINT *, 'Call sequence information: guide'      !!PRINT *, 'Call sequence information: guide'
88    
89      first_call: IF (itau == 0) THEN      first_call: IF (itau == 0) THEN
90         CALL conf_guide         CALL conf_guide
        CALL inigrads(igrads, rlonv, 180. / pi, -180., 180., rlatu, -90., &  
             90., 180. / pi, presnivs, 1., dtgrads, 'guide', 'dyn_zon ')  
91    
92         IF (online) THEN         IF (online) THEN
93            ! Constantes de temps de rappel en jour            ! Constantes de temps de rappel en jour
# Line 115  CONTAINS Line 104  CONTAINS
104    
105            factt = dtvr * iperiod / daysec            factt = dtvr * iperiod / daysec
106    
107            CALL tau2alpha(3, iip1, jjm, factt, tau_min_v, tau_max_v, alpha_v)            if (guide_u) CALL tau2alpha(3, factt, tau_min_v, tau_max_v, alpha_v)
108            CALL tau2alpha(2, iip1, jjp1, factt, tau_min_u, tau_max_u, alpha_u)            if (guide_v) CALL tau2alpha(2, factt, tau_min_u, tau_max_u, alpha_u)
109            CALL tau2alpha(1, iip1, jjp1, factt, tau_min_t, tau_max_t, alpha_t)            if (guide_t) CALL tau2alpha(1, factt, tau_min_t, tau_max_t, alpha_t)
110            CALL tau2alpha(1, iip1, jjp1, factt, tau_min_p, tau_max_p, alpha_p)            if (guide_q) CALL tau2alpha(1, factt, tau_min_q, tau_max_q, alpha_q)
           CALL tau2alpha(1, iip1, jjp1, factt, tau_min_q, tau_max_q, alpha_q)  
   
           CALL dump2d(iip1, jjp1, aire, 'AIRE MAILLe ')  
           CALL dump2d(iip1, jjp1, alpha_u, 'COEFF U ')  
           CALL dump2d(iip1, jjp1, alpha_t, 'COEFF T ')  
111         ELSE         ELSE
112            ! Cas ou on force exactement par les variables analysees            ! Cas où on force exactement par les variables analysées
113            alpha_t = 0.            if (guide_u) alpha_t = 1.
114            alpha_u = 0.            if (guide_v) alpha_u = 1.
115            alpha_v = 0.            if (guide_t) alpha_v = 1.
116            alpha_p = 0.            if (guide_q) alpha_q = 1.
117         END IF         END IF
118    
119         step_rea = 1         step_rea = 1
120         count_no_rea = 0         count_no_rea = 0
        ncidpl = -99  
121    
122         ! lecture d'un fichier netcdf pour determiner le nombre de niveaux         ! lecture d'un fichier netcdf pour determiner le nombre de niveaux
123         if (guide_u) call nf95_open('u.nc',Nf90_NOWRITe,ncidpl)         if (guide_u) then
124         if (guide_v) call nf95_open('v.nc',nf90_nowrite,ncidpl)            call nf95_open('u.nc',Nf90_NOWRITe,ncid)
125         if (guide_T) call nf95_open('T.nc',nf90_nowrite,ncidpl)         else if (guide_v) then
126         if (guide_Q) call nf95_open('hur.nc',nf90_nowrite, ncidpl)            call nf95_open('v.nc',nf90_nowrite,ncid)
127           else if (guide_T) then
128              call nf95_open('T.nc',nf90_nowrite,ncid)
129           else
130              call nf95_open('hur.nc',nf90_nowrite, ncid)
131           end if
132    
133         IF (ncep) THEN         IF (ncep) THEN
134            status = nf90_inq_dimid(ncidpl, 'LEVEL', rid)            call nf95_inq_dimid(ncid, 'LEVEL', dimid)
135         ELSE         ELSE
136            status = nf90_inq_dimid(ncidpl, 'PRESSURE', rid)            call nf95_inq_dimid(ncid, 'PRESSURE', dimid)
137         END IF         END IF
138         call nf95_inquire_dimension(ncidpl, rid, nclen=nlev)         call nf95_inquire_dimension(ncid, dimid, nclen=nlev)
139         PRINT *, 'nlev', nlev         PRINT *, 'nlev', nlev
140         rcod = nf90_close(ncidpl)         call nf95_close(ncid)
141         ! Lecture du premier etat des reanalyses.         ! Lecture du premier etat des reanalyses.
142         CALL read_reanalyse(1, ps, ucovrea2, vcovrea2, tetarea2, qrea2, &         CALL read_reanalyse(1, ps, ucovrea2, vcovrea2, tetarea2, qrea2, &
143              masserea2, nlev)              masserea2, nlev)
144         qrea2 = max(qrea2, 0.1)         qrea2 = max(qrea2, 0.1)
145    
146           if (guide_u) CALL writefield("alpha_u", alpha_u)
147           if (guide_t) CALL writefield("alpha_t", alpha_t)
148      END IF first_call      END IF first_call
149    
150      ! IMPORTATION DES VENTS, PRESSION ET TEMPERATURE REELS:      ! IMPORTATION DES VENTS, PRESSION ET TEMPERATURE REELS:
# Line 172  CONTAINS Line 163  CONTAINS
163              masserea2, nlev)              masserea2, nlev)
164         qrea2 = max(qrea2, 0.1)         qrea2 = max(qrea2, 0.1)
165         factt = dtvr * iperiod / daysec         factt = dtvr * iperiod / daysec
166         ztau = factt / max(alpha_t, 1E-10)  
167         CALL wrgrads(igrads, 1, aire, 'aire ', 'aire ')         if (guide_u) then
168         CALL wrgrads(igrads, 1, dxdys, 'dxdy ', 'dxdy ')            CALL writefield("ucov", ucov)
169         CALL wrgrads(igrads, 1, alpha_u, 'au ', 'au ')            CALL writefield("ucovrea2", ucovrea2)
170         CALL wrgrads(igrads, 1, alpha_t, 'at ', 'at ')         end if
171         CALL wrgrads(igrads, 1, ztau, 'taut ', 'taut ')  
172         CALL wrgrads(igrads, llm, ucov, 'u ', 'u ')         if (guide_t) then
173         CALL wrgrads(igrads, llm, ucovrea2, 'ua ', 'ua ')            CALL writefield("teta", teta)
174         CALL wrgrads(igrads, llm, teta, 'T ', 'T ')            CALL writefield("tetarea2", tetarea2)
175         CALL wrgrads(igrads, llm, tetarea2, 'Ta ', 'Ta ')         end if
176         CALL wrgrads(igrads, llm, qrea2, 'Qa ', 'Qa ')  
177         CALL wrgrads(igrads, llm, q, 'Q ', 'Q ')         if (guide_q) then
178              CALL writefield("qrea2", qrea2)
179              CALL writefield("q", q)
180           end if
181      ELSE      ELSE
182         count_no_rea = count_no_rea + 1         count_no_rea = count_no_rea + 1
183      END IF      END IF
Legend:
Removed from v.102  
changed lines
  Added in v.114
  ViewVC Help
Powered by ViewVC 1.1.21