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