/[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

trunk/libf/dyn3d/guide.f90 revision 37 by guez, Tue Dec 21 15:45:48 2010 UTC trunk/dyn3d/guide.f revision 91 by guez, Wed Mar 26 17:18:58 2014 UTC
# Line 5  MODULE guide_m Line 5  MODULE guide_m
5    
6    IMPLICIT NONE    IMPLICIT NONE
7    
   REAL tau_min_u, tau_max_u  
   REAL tau_min_v, tau_max_v  
   REAL tau_min_t, tau_max_t  
   REAL tau_min_q, tau_max_q  
   REAL tau_min_p, tau_max_p  
8    REAL aire_min, aire_max    REAL aire_min, aire_max
9    
   
   LOGICAL guide_u, guide_v, guide_t, guide_q, guide_p  
   LOGICAL ncep, ini_anal  
   INTEGER online  
   
10  CONTAINS  CONTAINS
11    
12    SUBROUTINE guide(itau, ucov, vcov, teta, q, masse, ps)    SUBROUTINE guide(itau, ucov, vcov, teta, q, masse, ps)
13    
14      ! Author: F.Hourdin      ! Author: F.Hourdin
15    
16      USE dimens_m, ONLY : jjm, llm      USE comconst, ONLY: cpp, daysec, dtvr, kappa
17      USE paramet_m, ONLY : iip1, ip1jm, ip1jmp1, jjp1, llmp1      USE comgeom, ONLY: aire, rlatu, rlonv
18      USE comconst, ONLY : cpp, daysec, dtvr, kappa, pi      USE conf_gcm_m, ONLY: day_step, iperiod
19      USE comvert, ONLY : ap, bp, preff, presnivs      use conf_guide_m, only: conf_guide, guide_u, guide_v, guide_t, guide_q, &
20      USE conf_gcm_m, ONLY : day_step, iperiod           ncep, ini_anal, tau_min_u, tau_max_u, tau_min_v, tau_max_v, &
21      USE comgeom, ONLY : aire, rlatu, rlonv           tau_min_t, tau_max_t, tau_min_q, tau_max_q, tau_min_p, tau_max_p, &
22      USE serre, ONLY : clat, clon           online
23      USE q_sat_m, ONLY : q_sat      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 netcdf, only: nf90_nowrite, nf90_open, nf90_close      USE inigrads_m, ONLY: inigrads
27      use tau2alpha_m, only: tau2alpha      use massdair_m, only: massdair
28        use netcdf, only: nf90_nowrite, nf90_open, nf90_close, nf90_inq_dimid, &
29      INCLUDE 'netcdf.inc'           nf90_inquire_dimension
30        use nr_util, only: pi
31      !   variables dynamiques      USE paramet_m, ONLY: iip1, ip1jm, ip1jmp1, jjp1, llmp1
32      REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm) ! vents covariants      USE q_sat_m, ONLY: q_sat
33      REAL, intent(inout):: teta(ip1jmp1, llm) ! temperature potentielle      use read_reanalyse_m, only: read_reanalyse
34      REAL q(ip1jmp1, llm) ! temperature potentielle      USE serre, ONLY: clat, clon
35      REAL ps(ip1jmp1) ! pression  au sol      use tau2alpha_m, only: tau2alpha, dxdys
36      REAL masse(ip1jmp1, llm) ! masse d'air  
37        INTEGER, INTENT(IN):: itau
38      !   common passe pour des sorties  
39      REAL dxdys(iip1, jjp1), dxdyu(iip1, jjp1), dxdyv(iip1, jjm)      ! variables dynamiques
40      COMMON /comdxdy/dxdys, dxdyu, dxdyv      REAL ucov(ip1jmp1, llm), vcov(ip1jm, llm) ! vents covariants
41        REAL, intent(inout):: teta(iim + 1, jjm + 1, llm) ! température potentielle
42      !   variables dynamiques pour les reanalyses.      REAL q(iim + 1, jjm + 1, llm)
43      REAL ucovrea1(ip1jmp1, llm), vcovrea1(ip1jm, llm) !vts cov reas      REAL, intent(out):: masse(ip1jmp1, llm) ! masse d'air
44      REAL tetarea1(ip1jmp1, llm) ! temp pot  reales      REAL, intent(in):: ps(:, :) ! (iim + 1, jjm + 1) pression au sol
45      REAL qrea1(ip1jmp1, llm) ! temp pot  reales  
46      REAL psrea1(ip1jmp1) ! ps      ! Local:
47      REAL ucovrea2(ip1jmp1, llm), vcovrea2(ip1jm, llm) !vts cov reas  
48      REAL tetarea2(ip1jmp1, llm) ! temp pot  reales      ! variables dynamiques pour les reanalyses.
49      REAL qrea2(ip1jmp1, llm) ! temp pot  reales      REAL, save:: ucovrea1(ip1jmp1, llm), vcovrea1(ip1jm, llm) !vts cov reas
50      REAL masserea2(ip1jmp1, llm) ! masse      REAL, save:: tetarea1(iim + 1, jjm + 1, llm) ! temp pot reales
51      REAL psrea2(ip1jmp1) ! ps      REAL, save:: qrea1(iim + 1, jjm + 1, llm) ! temp pot reales
52        REAL, save:: ucovrea2(ip1jmp1, llm), vcovrea2(ip1jm, llm) !vts cov reas
53      REAL alpha_q(ip1jmp1)      REAL, save:: tetarea2(iim + 1, jjm + 1, llm) ! temp pot reales
54      REAL alpha_t(ip1jmp1), alpha_p(ip1jmp1)      REAL, save:: qrea2(iim + 1, jjm + 1, llm) ! temp pot reales
55      REAL alpha_u(ip1jmp1), alpha_v(ip1jm)      REAL, save:: masserea2(ip1jmp1, llm) ! masse
56      REAL dday_step, toto, reste, itau_test  
57      INTEGER step_rea, count_no_rea      REAL, save:: alpha_q(iim + 1, jjm + 1)
58        REAL, save:: alpha_t(iim + 1, jjm + 1), alpha_p(ip1jmp1)
59        REAL, save:: alpha_u(ip1jmp1), alpha_v(ip1jm)
60        REAL dday_step, toto, reste
61        real, save:: itau_test
62        INTEGER, save:: step_rea, count_no_rea
63    
64      INTEGER ilon, ilat      INTEGER ilon, ilat
65      REAL factt, ztau(ip1jmp1)      REAL factt, ztau(iim + 1, jjm + 1)
66    
67      INTEGER, INTENT (IN) :: itau      INTEGER ij, i, j, l
68      INTEGER ij, l      INTEGER ncidpl, status
     INTEGER ncidpl, varidpl, nlev, status  
69      INTEGER rcod, rid      INTEGER rcod, rid
70      REAL ditau, tau, a      REAL ditau, tau, a
71      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)
75      REAL pkf(ip1jmp1, llm)      real pk(iim + 1, jjm + 1, llm), pks(iim + 1, jjm + 1)
76      REAL pres(ip1jmp1, llm)      REAL pres(iim + 1, jjm + 1, llm)
77    
78      REAL qsat(ip1jmp1, llm)      REAL qsat(iim + 1, jjm + 1, llm)
79      REAL unskap      REAL unskap
80      REAL tnat(ip1jmp1, llm)      REAL tnat(iim + 1, jjm + 1, llm)
81    
82      LOGICAL:: first = .TRUE.      LOGICAL:: first = .TRUE.
83        CHARACTER(len=10) file
84      SAVE ucovrea1, vcovrea1, tetarea1, psrea1, qrea1      INTEGER:: igrads = 2
85      SAVE ucovrea2, vcovrea2, tetarea2, masserea2, psrea2, qrea2      REAL:: dtgrads = 100.
   
     SAVE alpha_t, alpha_q, alpha_u, alpha_v, alpha_p, itau_test  
     SAVE step_rea, count_no_rea  
   
     CHARACTER (10) file  
     INTEGER igrads  
     REAL dtgrads  
     SAVE igrads, dtgrads  
     DATA igrads, dtgrads/2, 100./  
86    
87      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
88    
# Line 105  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      PRINT *, 'OK1'      CALL exner_hyb(ps, p, pks, pk)
96      CALL exner_hyb(ps, p, pks, pk, pkf)      tnat = pk * teta / cpp
97      PRINT *, 'OK2'      unskap = 1. / kappa
98      tnat(:, :) = pk(:, :)*teta(:, :)/cpp      pres = preff * (pk / cpp)**unskap
     PRINT *, 'OK3'  
     unskap = 1./kappa  
     pres(:, :) = preff*(pk(:, :)/cpp)**unskap  
     PRINT *, 'OK4'  
99      qsat = q_sat(tnat, pres)      qsat = q_sat(tnat, pres)
100    
101      !   initialisations pour la lecture des reanalyses.      ! initialisations pour la lecture des reanalyses.
102      !    alpha determine la part des injections de donnees a chaque etape      ! alpha determine la part des injections de donnees a chaque etape
103      !    alpha=1 signifie pas d'injection      ! alpha=1 signifie pas d'injection
104      !    alpha=0 signifie injection totale      ! alpha=0 signifie injection totale
105    
106      PRINT *, 'ONLINE=', online      IF (online /= - 1) THEN
107      IF (online==-1) THEN         IF (first) THEN
108         RETURN            CALL conf_guide
109      END IF            file = 'guide'
110              CALL inigrads(igrads, rlonv, 180. / pi, -180., 180., rlatu, -90., 90., &
111      IF (first) THEN                 180. / pi, presnivs, 1., dtgrads, file, 'dyn_zon ')
112              PRINT *, '1: en-ligne, 0: hors-ligne (x=x_rea), -1: climat (x=x_gcm)'
113         PRINT *, 'initialisation du guide '  
114         CALL conf_guide            IF (online==1) THEN
115         PRINT *, 'apres conf_guide'               ! Constantes de temps de rappel en jour
116                 ! 0.1 c'est en gros 2h30.
117         file = 'guide'               ! 1e10 est une constante infinie donc en gros pas de guidage
118         CALL inigrads(igrads, rlonv, 180./pi, -180., 180., rlatu, -90., 90., &  
119              180./pi, presnivs, 1., dtgrads, file, 'dyn_zon ')               ! coordonnees du centre du zoom
120                 CALL coordij(clon, clat, ilon, ilat)
121         PRINT *, &               ! aire de la maille au centre du zoom
122              '1: en-ligne, 0: hors-ligne (x=x_rea), -1: climat (x=x_gcm)'               aire_min = aire(ilon+(ilat - 1) * iip1)
123                 ! aire maximale de la maille
124         IF (online==-1) RETURN               aire_max = 0.
125         IF (online==1) THEN               DO ij = 1, ip1jmp1
126                    aire_max = max(aire_max, aire(ij))
127            !  Constantes de temps de rappel en jour               END DO
128            !  0.1 c'est en gros 2h30.               ! factt = pas de temps en fraction de jour
129            !  1e10  est une constante infinie donc en gros pas de guidage               factt = dtvr * iperiod / daysec
130    
131            !   coordonnees du centre du zoom               CALL tau2alpha(3, iip1, jjm, factt, tau_min_v, tau_max_v, alpha_v)
132            CALL coordij(clon, clat, ilon, ilat)               CALL tau2alpha(2, iip1, jjp1, factt, tau_min_u, tau_max_u, alpha_u)
133            !   aire de la maille au centre du zoom               CALL tau2alpha(1, iip1, jjp1, factt, tau_min_t, tau_max_t, alpha_t)
134            aire_min = aire(ilon+(ilat-1)*iip1)               CALL tau2alpha(1, iip1, jjp1, factt, tau_min_p, tau_max_p, alpha_p)
135            !   aire maximale de la maille               CALL tau2alpha(1, iip1, jjp1, factt, tau_min_q, tau_max_q, alpha_q)
136            aire_max = 0.  
137            DO ij = 1, ip1jmp1               CALL dump2d(iip1, jjp1, aire, 'AIRE MAILLe ')
138               aire_max = max(aire_max, aire(ij))               CALL dump2d(iip1, jjp1, alpha_u, 'COEFF U ')
139            END DO               CALL dump2d(iip1, jjp1, alpha_t, 'COEFF T ')
140            !  factt = pas de temps en fraction de jour  
141            factt = dtvr*iperiod/daysec               ! Cas ou on force exactement par les variables analysees
142              ELSE
143            CALL tau2alpha(3, iip1, jjm, factt, tau_min_v, tau_max_v, alpha_v)               alpha_t = 0.
144            CALL tau2alpha(2, iip1, jjp1, factt, tau_min_u, tau_max_u, alpha_u)               alpha_u = 0.
145            CALL tau2alpha(1, iip1, jjp1, factt, tau_min_t, tau_max_t, alpha_t)               alpha_v = 0.
146            CALL tau2alpha(1, iip1, jjp1, factt, tau_min_p, tau_max_p, alpha_p)               alpha_p = 0.
147            CALL tau2alpha(1, iip1, jjp1, factt, tau_min_q, tau_max_q, alpha_q)               ! physic=.false.
148              END IF
149            CALL dump2d(iip1, jjp1, aire, 'AIRE MAILLe ')  
150            CALL dump2d(iip1, jjp1, alpha_u, 'COEFF U   ')            itau_test = 1001
151            CALL dump2d(iip1, jjp1, alpha_t, 'COEFF T   ')            step_rea = 1
152              count_no_rea = 0
153            !   Cas ou on force exactement par les variables analysees            ncidpl = -99
154         ELSE  
155            alpha_t = 0.            ! itau_test montre si l'importation a deja ete faite au rang itau
156            alpha_u = 0.            ! lecture d'un fichier netcdf pour determiner le nombre de niveaux
157            alpha_v = 0.            if (guide_u) then
158            alpha_p = 0.               if (ncidpl.eq. - 99) rcod=nf90_open('u.nc',Nf90_NOWRITe,ncidpl)
159            !           physic=.false.            endif
160         END IF  
161              if (guide_v) then
162                 if (ncidpl.eq. - 99) rcod=nf90_open('v.nc',nf90_nowrite,ncidpl)
163              endif
164    
165              if (guide_T) then
166                 if (ncidpl.eq. - 99) rcod=nf90_open('T.nc',nf90_nowrite,ncidpl)
167              endif
168    
169              if (guide_Q) then
170                 if (ncidpl.eq. - 99) rcod=nf90_open('hur.nc',nf90_nowrite, ncidpl)
171              endif
172    
173              IF (ncep) THEN
174                 status = nf90_inq_dimid(ncidpl, 'LEVEL', rid)
175              ELSE
176                 status = nf90_inq_dimid(ncidpl, 'PRESSURE', rid)
177              END IF
178              status = nf90_inquire_dimension(ncidpl, rid, len=nlev)
179              PRINT *, 'nlev', nlev
180              rcod = nf90_close(ncidpl)
181              ! Lecture du premier etat des reanalyses.
182              CALL read_reanalyse(1, ps, ucovrea2, vcovrea2, tetarea2, qrea2, &
183                   masserea2, nlev)
184              qrea2 = max(qrea2, 0.1)
185    
186              ! Debut de l'integration temporelle:
187           END IF ! first
188    
189           ! IMPORTATION DES VENTS, PRESSION ET TEMPERATURE REELS:
190    
191           ditau = real(itau)
192           dday_step = real(day_step)
193           WRITE (*, *) 'ditau, dday_step'
194           WRITE (*, *) ditau, dday_step
195           toto = 4 * ditau / dday_step
196           reste = toto - aint(toto)
197    
198           IF (reste==0.) THEN
199              IF (itau_test==itau) THEN
200                 WRITE (*, *) 'deuxieme passage de advreel a itau=', itau
201                 STOP
202              ELSE
203                 vcovrea1 = vcovrea2
204                 ucovrea1 = ucovrea2
205                 tetarea1 = tetarea2
206                 qrea1 = qrea2
207    
208                 PRINT *, 'LECTURE REANALYSES, pas ', step_rea, 'apres ', &
209                      count_no_rea, ' non lectures'
210                 step_rea = step_rea + 1
211                 itau_test = itau
212                 CALL read_reanalyse(step_rea, ps, ucovrea2, vcovrea2, tetarea2, &
213                      qrea2, masserea2, nlev)
214                 qrea2 = max(qrea2, 0.1)
215                 factt = dtvr * iperiod / daysec
216                 ztau = factt / max(alpha_t, 1E-10)
217                 CALL wrgrads(igrads, 1, aire, 'aire ', 'aire ')
218                 CALL wrgrads(igrads, 1, dxdys, 'dxdy ', 'dxdy ')
219                 CALL wrgrads(igrads, 1, alpha_u, 'au ', 'au ')
220                 CALL wrgrads(igrads, 1, alpha_t, 'at ', 'at ')
221                 CALL wrgrads(igrads, 1, ztau, 'taut ', 'taut ')
222                 CALL wrgrads(igrads, llm, ucov, 'u ', 'u ')
223                 CALL wrgrads(igrads, llm, ucovrea2, 'ua ', 'ua ')
224                 CALL wrgrads(igrads, llm, teta, 'T ', 'T ')
225                 CALL wrgrads(igrads, llm, tetarea2, 'Ta ', 'Ta ')
226                 CALL wrgrads(igrads, llm, qrea2, 'Qa ', 'Qa ')
227                 CALL wrgrads(igrads, llm, q, 'Q ', 'Q ')
228    
229         itau_test = 1001               CALL wrgrads(igrads, llm, qsat, 'QSAT ', 'QSAT ')
        step_rea = 1  
        count_no_rea = 0  
        ncidpl = -99  
   
        !    itau_test    montre si l'importation a deja ete faite au rang itau  
        ! lecture d'un fichier netcdf pour determiner le nombre de niveaux  
        if (guide_u) then  
           if (ncidpl.eq.-99) rcod=nf90_open('u.nc',Nf90_NOWRITe,ncidpl)  
        endif  
   
        if (guide_v) then  
           if (ncidpl.eq.-99) rcod=nf90_open('v.nc',nf90_nowrite,ncidpl)  
        endif  
   
        if (guide_T) then  
           if (ncidpl.eq.-99) rcod=nf90_open('T.nc',nf90_nowrite,ncidpl)  
        endif  
   
        if (guide_Q) then  
           if (ncidpl.eq.-99) rcod=nf90_open('hur.nc',nf90_nowrite, ncidpl)  
        endif  
230    
231         IF (ncep) THEN            END IF
           status = nf_inq_dimid(ncidpl, 'LEVEL', rid)  
232         ELSE         ELSE
233            status = nf_inq_dimid(ncidpl, 'PRESSURE', rid)            count_no_rea = count_no_rea + 1
234         END IF         END IF
        status = nf_inq_dimlen(ncidpl, rid, nlev)  
        PRINT *, 'nlev', nlev  
        rcod = nf90_close(ncidpl)  
        !   Lecture du premier etat des reanalyses.  
        CALL read_reanalyse(1, ps, ucovrea2, vcovrea2, tetarea2, qrea2, &  
             masserea2, psrea2, 1, nlev)  
        qrea2(:, :) = max(qrea2(:, :), 0.1)  
   
   
        !   Debut de l'integration temporelle:  
     END IF ! first  
   
     ! IMPORTATION DES VENTS, PRESSION ET TEMPERATURE REELS:  
   
     ditau = real(itau)  
     dday_step = real(day_step)  
     WRITE (*, *) 'ditau, dday_step'  
     WRITE (*, *) ditau, dday_step  
     toto = 4*ditau/dday_step  
     reste = toto - aint(toto)  
   
     IF (reste==0.) THEN  
        IF (itau_test==itau) THEN  
           WRITE (*, *) 'deuxieme passage de advreel a itau=', itau  
           STOP  
        ELSE  
           vcovrea1(:, :) = vcovrea2(:, :)  
           ucovrea1(:, :) = ucovrea2(:, :)  
           tetarea1(:, :) = tetarea2(:, :)  
           qrea1(:, :) = qrea2(:, :)  
   
           PRINT *, 'LECTURE REANALYSES, pas ', step_rea, 'apres ', &  
                count_no_rea, ' non lectures'  
           step_rea = step_rea + 1  
           itau_test = itau  
           CALL read_reanalyse(step_rea, ps, ucovrea2, vcovrea2, tetarea2, &  
                qrea2, masserea2, psrea2, 1, nlev)  
           qrea2(:, :) = max(qrea2(:, :), 0.1)  
           factt = dtvr*iperiod/daysec  
           ztau(:) = factt/max(alpha_t(:), 1.E-10)  
           CALL wrgrads(igrads, 1, aire, 'aire      ', 'aire      ')  
           CALL wrgrads(igrads, 1, dxdys, 'dxdy      ', 'dxdy      ')  
           CALL wrgrads(igrads, 1, alpha_u, 'au        ', 'au        ')  
           CALL wrgrads(igrads, 1, alpha_t, 'at        ', 'at        ')  
           CALL wrgrads(igrads, 1, ztau, 'taut      ', 'taut      ')  
           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         ')  
   
           CALL wrgrads(igrads, llm, qsat, 'QSAT      ', 'QSAT      ')  
   
        END IF  
     ELSE  
        count_no_rea = count_no_rea + 1  
     END IF  
   
     !   Guidage  
     !    x_gcm = a * x_gcm + (1-a) * x_reanalyses  
235    
236      IF (ini_anal) PRINT *, 'ATTENTION !!! ON PART DU GUIDAGE'         ! Guidage
237           ! x_gcm = a * x_gcm + (1 - a) * x_reanalyses
238    
239      ditau = real(itau)         IF (ini_anal) PRINT *, 'ATTENTION !!! ON PART DU GUIDAGE'
     dday_step = real(day_step)  
240    
241           ditau = real(itau)
242           dday_step = real(day_step)
243    
244      tau = 4*ditau/dday_step         tau = 4 * ditau / dday_step
245      tau = tau - aint(tau)         tau = tau - aint(tau)
246    
247      !  ucov         ! ucov
248      IF (guide_u) THEN         IF (guide_u) THEN
249         DO l = 1, llm            DO l = 1, llm
250            DO ij = 1, ip1jmp1               DO ij = 1, ip1jmp1
251               a = (1.-tau)*ucovrea1(ij, l) + tau*ucovrea2(ij, l)                  a = (1. - tau) * ucovrea1(ij, l) + tau * ucovrea2(ij, l)
252               ucov(ij, l) = (1.-alpha_u(ij))*ucov(ij, l) + alpha_u(ij)*a                  ucov(ij, l) = (1. - alpha_u(ij)) * ucov(ij, l) + alpha_u(ij) * a
253               IF (first .AND. ini_anal) ucov(ij, l) = a                  IF (first .AND. ini_anal) ucov(ij, l) = a
254                 END DO
255            END DO            END DO
256         END DO         END IF
     END IF  
257    
258      IF (guide_t) THEN         IF (guide_t) THEN
259         DO l = 1, llm            DO l = 1, llm
260            DO ij = 1, ip1jmp1               do j = 1, jjm + 1
261               a = (1.-tau)*tetarea1(ij, l) + tau*tetarea2(ij, l)                  DO i = 1, iim + 1
262               teta(ij, l) = (1.-alpha_t(ij))*teta(ij, l) + alpha_t(ij)*a                     a = (1. - tau) * tetarea1(i, j, l) + tau * tetarea2(i, j, l)
263               IF (first .AND. ini_anal) teta(ij, l) = a                     teta(i, j, l) = (1. - alpha_t(i, j)) * teta(i, j, l) &
264                            + alpha_t(i, j) * a
265                       IF (first .AND. ini_anal) teta(i, j, l) = a
266                    END DO
267                 end do
268            END DO            END DO
269         END DO         END IF
     END IF  
270    
271      !  P         IF (guide_q) THEN
272      IF (guide_p) THEN            DO l = 1, llm
273         DO ij = 1, ip1jmp1               do j = 1, jjm + 1
274            a = (1.-tau)*psrea1(ij) + tau*psrea2(ij)                  DO i = 1, iim + 1
275            ps(ij) = (1.-alpha_p(ij))*ps(ij) + alpha_p(ij)*a                     a = (1. - tau) * qrea1(i, j, l) + tau * qrea2(i, j, l)
276            IF (first .AND. ini_anal) ps(ij) = a                     ! hum relative en % -> hum specif
277         END DO                     a = qsat(i, j, l) * a * 0.01
278         forall (l = 1: llm + 1) p(:, l) = ap(l) + bp(l) * ps                     q(i, j, l) = (1. - alpha_q(i, j)) * q(i, j, l) &
279         CALL massdair(p, masse)                          + alpha_q(i, j) * a
280      END IF                     IF (first .AND. ini_anal) q(i, j, l) = a
281                    END DO
282                 end do
     !  q  
     IF (guide_q) THEN  
        DO l = 1, llm  
           DO ij = 1, ip1jmp1  
              a = (1.-tau)*qrea1(ij, l) + tau*qrea2(ij, l)  
              !   hum relative en % -> hum specif  
              a = qsat(ij, l)*a*0.01  
              q(ij, l) = (1.-alpha_q(ij))*q(ij, l) + alpha_q(ij)*a  
              IF (first .AND. ini_anal) q(ij, l) = a  
283            END DO            END DO
284         END DO         END IF
     END IF  
285    
286      ! vcov         ! vcov
287      IF (guide_v) THEN         IF (guide_v) THEN
288         DO l = 1, llm            DO l = 1, llm
289            DO ij = 1, ip1jm               DO ij = 1, ip1jm
290               a = (1.-tau)*vcovrea1(ij, l) + tau*vcovrea2(ij, l)                  a = (1. - tau) * vcovrea1(ij, l) + tau * vcovrea2(ij, l)
291               vcov(ij, l) = (1.-alpha_v(ij))*vcov(ij, l) + alpha_v(ij)*a                  vcov(ij, l) = (1. - alpha_v(ij)) * vcov(ij, l) + alpha_v(ij) * a
292                    IF (first .AND. ini_anal) vcov(ij, l) = a
293                 END DO
294               IF (first .AND. ini_anal) vcov(ij, l) = a               IF (first .AND. ini_anal) vcov(ij, l) = a
295            END DO            END DO
296            IF (first .AND. ini_anal) vcov(ij, l) = a         END IF
        END DO  
     END IF  
297    
298      first = .FALSE.         first = .FALSE.
299        end IF
300    
301    END SUBROUTINE guide    END SUBROUTINE guide
302    
Legend:
Removed from v.37  
changed lines
  Added in v.91
  ViewVC Help
Powered by ViewVC 1.1.21