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

revision 171 by guez, Tue Sep 29 19:48:59 2015 UTC revision 172 by guez, Wed Sep 30 15:59:14 2015 UTC
# Line 21  CONTAINS Line 21  CONTAINS
21      use dynetat0_m, only: grossismx, grossismy, rlatu, rlatv      use dynetat0_m, only: grossismx, grossismy, rlatu, rlatv
22      USE exner_hyb_m, ONLY: exner_hyb      USE exner_hyb_m, ONLY: exner_hyb
23      use init_tau2alpha_m, only: init_tau2alpha      use init_tau2alpha_m, only: init_tau2alpha
     use netcdf, only: nf90_nowrite  
     use netcdf95, only: nf95_close, nf95_inq_dimid, nf95_inquire_dimension, &  
          nf95_open  
24      use nr_util, only: pi      use nr_util, only: pi
25      USE paramet_m, ONLY: iip1, ip1jmp1, jjp1, llmp1      USE paramet_m, ONLY: iip1, ip1jmp1, jjp1, llmp1
26      USE q_sat_m, ONLY: q_sat      USE q_sat_m, ONLY: q_sat
# Line 56  CONTAINS Line 53  CONTAINS
53    
54      REAL, save:: tetarea2(iim + 1, jjm + 1, llm) ! temp pot reales      REAL, save:: tetarea2(iim + 1, jjm + 1, llm) ! temp pot reales
55      REAL, save:: qrea2(iim + 1, jjm + 1, llm) ! temp pot reales      REAL, save:: qrea2(iim + 1, jjm + 1, llm) ! temp pot reales
     REAL, save:: masserea2(ip1jmp1, llm) ! masse  
56    
57      ! alpha détermine la part des injections de données à chaque étape      ! alpha détermine la part des injections de données à chaque étape
58      ! alpha=0 signifie pas d'injection      ! alpha=0 signifie pas d'injection
# Line 65  CONTAINS Line 61  CONTAINS
61      REAL, save:: alpha_t(iim + 1, jjm + 1)      REAL, save:: alpha_t(iim + 1, jjm + 1)
62      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)
63    
     INTEGER, save:: step_rea, count_no_rea  
   
64      INTEGER l      INTEGER l
     INTEGER ncid, dimid  
65      REAL tau      REAL tau
     INTEGER, SAVE:: nlev  
66    
67      ! TEST SUR QSAT      ! TEST SUR QSAT
68      REAL p(iim + 1, jjm + 1, llmp1)      REAL p(iim + 1, jjm + 1, llmp1)
# Line 81  CONTAINS Line 73  CONTAINS
73    
74      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
75    
76      !!PRINT *, 'Call sequence information: guide'      IF (itau == 0) THEN
   
     first_call: IF (itau == 0) THEN  
77         IF (online) THEN         IF (online) THEN
78            IF (abs(grossismx - 1.) < 0.1 .OR. abs(grossismy - 1.) < 0.1) THEN            IF (abs(grossismx - 1.) < 0.1 .OR. abs(grossismy - 1.) < 0.1) THEN
79               ! grille regulière               ! grille regulière
# Line 122  CONTAINS Line 112  CONTAINS
112            if (guide_q) alpha_q = 1.            if (guide_q) alpha_q = 1.
113         END IF         END IF
114    
        step_rea = 1  
        count_no_rea = 0  
   
        ! Lecture d'un fichier NetCDF pour d\'eterminer le nombre de niveaux :  
   
        if (guide_u) then  
           call nf95_open('u.nc',Nf90_NOWRITe,ncid)  
        else if (guide_v) then  
           call nf95_open('v.nc',nf90_nowrite,ncid)  
        else if (guide_T) then  
           call nf95_open('T.nc',nf90_nowrite,ncid)  
        else  
           call nf95_open('hur.nc',nf90_nowrite, ncid)  
        end if  
   
        IF (ncep) THEN  
           call nf95_inq_dimid(ncid, 'LEVEL', dimid)  
        ELSE  
           call nf95_inq_dimid(ncid, 'PRESSURE', dimid)  
        END IF  
        call nf95_inquire_dimension(ncid, dimid, nclen=nlev)  
        PRINT *, 'nlev = ', nlev  
        call nf95_close(ncid)  
   
115         ! Lecture du premier état des réanalyses :         ! Lecture du premier état des réanalyses :
116         CALL read_reanalyse(1, ps, ucovrea2, vcovrea2, tetarea2, qrea2, &         CALL read_reanalyse(ps, ucovrea2, vcovrea2, tetarea2, qrea2)
             masserea2, nlev)  
117         qrea2 = max(qrea2, 0.1)         qrea2 = max(qrea2, 0.1)
     END IF first_call  
118    
119      ! IMPORTATION DES VENTS, PRESSION ET TEMPERATURE REELS:         if (ini_anal) then
120              IF (guide_u) ucov = ucovrea2
121              IF (guide_v) vcov = vcovrea2
122              IF (guide_t) teta = tetarea2
123    
124              IF (guide_q) then
125                 ! Calcul de l'humidité saturante :
126                 forall (l = 1: llm + 1) p(:, :, l) = ap(l) + bp(l) * ps
127                 CALL exner_hyb(ps, p, pks, pk)
128                 q = q_sat(pk * teta / cpp, preff * (pk / cpp)**(1. / kappa)) &
129                      * qrea2 * 0.01
130              end IF
131           end if
132        END IF
133    
134        ! Importation des vents, pression et temp\'erature r\'eels :
135    
136      ! Nudging fields are given 4 times per day:      ! Nudging fields are given 4 times per day:
137      IF (mod(itau, day_step / 4) == 0) THEN      IF (mod(itau, day_step / 4) == 0) THEN
# Line 161  CONTAINS Line 140  CONTAINS
140         tetarea1 = tetarea2         tetarea1 = tetarea2
141         qrea1 = qrea2         qrea1 = qrea2
142    
143         PRINT *, 'Lecture fichiers guidage, pas ', step_rea, 'apres ', &         CALL read_reanalyse(ps, ucovrea2, vcovrea2, tetarea2, qrea2)
             count_no_rea, ' non lectures'  
        step_rea = step_rea + 1  
        CALL read_reanalyse(step_rea, ps, ucovrea2, vcovrea2, tetarea2, qrea2, &  
             masserea2, nlev)  
144         qrea2 = max(qrea2, 0.1)         qrea2 = max(qrea2, 0.1)
145    
146         if (guide_u) then         if (guide_u) then
# Line 182  CONTAINS Line 157  CONTAINS
157            CALL writefield("qrea2", qrea2)            CALL writefield("qrea2", qrea2)
158            CALL writefield("q", q)            CALL writefield("q", q)
159         end if         end if
     ELSE  
        count_no_rea = count_no_rea + 1  
160      END IF      END IF
161    
162      ! Guidage      ! Guidage
# Line 192  CONTAINS Line 165  CONTAINS
165    
166      ! x_gcm = a * x_gcm + (1 - a) * x_reanalyses      ! x_gcm = a * x_gcm + (1 - a) * x_reanalyses
167    
168      IF (guide_u) THEN      IF (guide_u) forall (l = 1: llm) ucov(:, :, l) = (1. - alpha_u) &
169         IF (itau == 0 .AND. ini_anal) then           * ucov(:, :, l) + alpha_u * ((1. - tau) * ucovrea1(:, :, l) + tau &
170            ucov = ucovrea1           * ucovrea2(:, :, l))
171         else  
172            forall (l = 1: llm) ucov(:, :, l) = (1. - alpha_u) * ucov(:, :, l) &      IF (guide_v) forall (l = 1: llm) vcov(:, :, l) = (1. - alpha_v) &
173                 + alpha_u * ((1. - tau) * ucovrea1(:, :, l) &           * vcov(:, :, l) + alpha_v * ((1. - tau) * vcovrea1(:, :, l) + tau &
174                 + tau * ucovrea2(:, :, l))           * vcovrea2(:, :, l))
175         end IF  
176      END IF      IF (guide_t) forall (l = 1: llm) teta(:, :, l) = (1. - alpha_t) &
177             * teta(:, :, l) + alpha_t * ((1. - tau) * tetarea1(:, :, l) + tau &
178      IF (guide_t) THEN           * tetarea2(:, :, l))
        IF (itau == 0 .AND. ini_anal) then  
           teta = tetarea1  
        else  
           forall (l = 1: llm) teta(:, :, l) = (1. - alpha_t) * teta(:, :, l) &  
                + alpha_t * ((1. - tau) * tetarea1(:, :, l) &  
                + tau * tetarea2(:, :, l))  
        end IF  
     END IF  
179    
180      IF (guide_q) THEN      IF (guide_q) THEN
181         ! Calcul de l'humidité saturante :         ! Calcul de l'humidité saturante :
# Line 219  CONTAINS Line 184  CONTAINS
184         qsat = q_sat(pk * teta / cpp, preff * (pk / cpp)**(1. / kappa))         qsat = q_sat(pk * teta / cpp, preff * (pk / cpp)**(1. / kappa))
185    
186         ! humidité relative en % -> humidité spécifique         ! humidité relative en % -> humidité spécifique
187         IF (itau == 0 .AND. ini_anal) then         forall (l = 1: llm) q(:, :, l) = (1. - alpha_q) * q(:, :, l) &
188            q = qsat * qrea1 * 0.01              + alpha_q * (qsat(:, :, l) * ((1. - tau) * qrea1(:, :, l) &
189         else              + tau * qrea2(:, :, l)) * 0.01)
           forall (l = 1: llm) q(:, :, l) = (1. - alpha_q) * q(:, :, l) &  
                + alpha_q * (qsat(:, :, l) * ((1. - tau) * qrea1(:, :, l) &  
                + tau * qrea2(:, :, l)) * 0.01)  
        end IF  
     END IF  
   
     IF (guide_v) THEN  
        IF (itau == 0 .AND. ini_anal) then  
           vcov = vcovrea1  
        else  
           forall (l = 1: llm) vcov(:, :, l) = (1. - alpha_v) * vcov(:, :, l) &  
                + alpha_v * ((1. - tau) * vcovrea1(:, :, l) &  
                + tau * vcovrea2(:, :, l))  
        end IF  
190      END IF      END IF
191    
192    END SUBROUTINE guide    END SUBROUTINE guide
Legend:
Removed from v.171  
changed lines
  Added in v.172
  ViewVC Help
Powered by ViewVC 1.1.21