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

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

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

revision 102 by guez, Tue Jul 15 13:43:24 2014 UTC revision 109 by guez, Wed Sep 17 10:08:00 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 67  CONTAINS Line 64  CONTAINS
64      ! alpha=1 signifie pas d'injection      ! alpha=1 signifie pas d'injection
65      ! alpha=0 signifie injection totale      ! alpha=0 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)            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)            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)            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)            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.            alpha_t = 0.
114            alpha_u = 0.            alpha_u = 0.
115            alpha_v = 0.            alpha_v = 0.
116            alpha_p = 0.            alpha_q = 0.
117         END IF         END IF
118    
119         step_rea = 1         step_rea = 1
120         count_no_rea = 0         count_no_rea = 0
121         ncidpl = -99         ncid = -99
122    
123         ! lecture d'un fichier netcdf pour determiner le nombre de niveaux         ! lecture d'un fichier netcdf pour determiner le nombre de niveaux
124         if (guide_u) call nf95_open('u.nc',Nf90_NOWRITe,ncidpl)         if (guide_u) call nf95_open('u.nc',Nf90_NOWRITe,ncid)
125         if (guide_v) call nf95_open('v.nc',nf90_nowrite,ncidpl)         if (guide_v) call nf95_open('v.nc',nf90_nowrite,ncid)
126         if (guide_T) call nf95_open('T.nc',nf90_nowrite,ncidpl)         if (guide_T) call nf95_open('T.nc',nf90_nowrite,ncid)
127         if (guide_Q) call nf95_open('hur.nc',nf90_nowrite, ncidpl)         if (guide_Q) call nf95_open('hur.nc',nf90_nowrite, ncid)
128    
129         IF (ncep) THEN         IF (ncep) THEN
130            status = nf90_inq_dimid(ncidpl, 'LEVEL', rid)            call nf95_inq_dimid(ncid, 'LEVEL', dimid)
131         ELSE         ELSE
132            status = nf90_inq_dimid(ncidpl, 'PRESSURE', rid)            call nf95_inq_dimid(ncid, 'PRESSURE', dimid)
133         END IF         END IF
134         call nf95_inquire_dimension(ncidpl, rid, nclen=nlev)         call nf95_inquire_dimension(ncid, dimid, nclen=nlev)
135         PRINT *, 'nlev', nlev         PRINT *, 'nlev', nlev
136         rcod = nf90_close(ncidpl)         call nf95_close(ncid)
137         ! Lecture du premier etat des reanalyses.         ! Lecture du premier etat des reanalyses.
138         CALL read_reanalyse(1, ps, ucovrea2, vcovrea2, tetarea2, qrea2, &         CALL read_reanalyse(1, ps, ucovrea2, vcovrea2, tetarea2, qrea2, &
139              masserea2, nlev)              masserea2, nlev)
140         qrea2 = max(qrea2, 0.1)         qrea2 = max(qrea2, 0.1)
141    
142           CALL writefield("alpha_u", alpha_u)
143           CALL writefield("alpha_t", alpha_t)
144      END IF first_call      END IF first_call
145    
146      ! IMPORTATION DES VENTS, PRESSION ET TEMPERATURE REELS:      ! IMPORTATION DES VENTS, PRESSION ET TEMPERATURE REELS:
# Line 172  CONTAINS Line 159  CONTAINS
159              masserea2, nlev)              masserea2, nlev)
160         qrea2 = max(qrea2, 0.1)         qrea2 = max(qrea2, 0.1)
161         factt = dtvr * iperiod / daysec         factt = dtvr * iperiod / daysec
162         ztau = factt / max(alpha_t, 1E-10)         CALL writefield("ucov", ucov)
163         CALL wrgrads(igrads, 1, aire, 'aire ', 'aire ')         CALL writefield("ucovrea2", ucovrea2)
164         CALL wrgrads(igrads, 1, dxdys, 'dxdy ', 'dxdy ')         CALL writefield("teta", teta)
165         CALL wrgrads(igrads, 1, alpha_u, 'au ', 'au ')         CALL writefield("tetarea2", tetarea2)
166         CALL wrgrads(igrads, 1, alpha_t, 'at ', 'at ')         CALL writefield("qrea2", qrea2)
167         CALL wrgrads(igrads, 1, ztau, 'taut ', 'taut ')         CALL writefield("q", q)
        CALL wrgrads(igrads, llm, ucov, 'u ', 'u ')  
        CALL wrgrads(igrads, llm, ucovrea2, 'ua ', 'ua ')  
        CALL wrgrads(igrads, llm, teta, 'T ', 'T ')  
        CALL wrgrads(igrads, llm, tetarea2, 'Ta ', 'Ta ')  
        CALL wrgrads(igrads, llm, qrea2, 'Qa ', 'Qa ')  
        CALL wrgrads(igrads, llm, q, 'Q ', 'Q ')  
168      ELSE      ELSE
169         count_no_rea = count_no_rea + 1         count_no_rea = count_no_rea + 1
170      END IF      END IF
Legend:
Removed from v.102  
changed lines
  Added in v.109
  ViewVC Help
Powered by ViewVC 1.1.21