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