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

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

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

trunk/dyn3d/guide.f revision 108 by guez, Tue Sep 16 14:00:41 2014 UTC trunk/dyn3d/Guide/guide.f revision 265 by guez, Tue Mar 20 09:35:59 2018 UTC
# Line 1  Line 1 
1  MODULE guide_m  MODULE guide_m
2    
3    ! From dyn3d/guide.F, version 1.3 2005/05/25 13:10:09    ! From dyn3d/guide.F, version 1.3, 2005/05/25 13:10:09
4    ! and dyn3d/guide.h, version 1.1.1.1 2004/05/19 12:53:06    ! and dyn3d/guide.h, version 1.1.1.1, 2004/05/19 12:53:06
5    
6    IMPLICIT NONE    IMPLICIT NONE
7    
   REAL aire_min, aire_max  
   
8  CONTAINS  CONTAINS
9    
10    SUBROUTINE guide(itau, ucov, vcov, teta, q, ps)    SUBROUTINE guide(itau, ucov, vcov, teta, q, ps)
11    
12      ! Author: F.Hourdin      ! Author: F. Hourdin
13    
14      USE comconst, ONLY: cpp, daysec, dtvr, kappa      USE comconst, ONLY: cpp, kappa
15      USE comgeom, ONLY: aire, rlatu, rlonv      USE conf_gcm_m, ONLY: day_step
16      USE conf_gcm_m, ONLY: day_step, iperiod      use conf_guide_m, only: guide_u, guide_v, guide_t, guide_q, ini_anal, &
17      use conf_guide_m, only: conf_guide, guide_u, guide_v, guide_t, guide_q, &           alpha_u, alpha_v, alpha_t, alpha_q
18           ncep, ini_anal, tau_min_u, tau_max_u, tau_min_v, tau_max_v, &      USE dimensions, ONLY: iim, jjm, llm
19           tau_min_t, tau_max_t, tau_min_q, tau_max_q, online      USE disvert_m, ONLY: ap, bp, preff
     USE dimens_m, ONLY: iim, jjm, llm  
     USE disvert_m, ONLY: ap, bp, preff, presnivs  
20      USE exner_hyb_m, ONLY: exner_hyb      USE exner_hyb_m, ONLY: exner_hyb
     use netcdf, only: nf90_nowrite  
     use netcdf95, only: nf95_close, nf95_inq_dimid, nf95_inquire_dimension, &  
          nf95_open  
     use nr_util, only: pi  
     USE paramet_m, ONLY: iip1, ip1jmp1, jjp1, llmp1  
21      USE q_sat_m, ONLY: q_sat      USE q_sat_m, ONLY: q_sat
22      use read_reanalyse_m, only: read_reanalyse      use read_reanalyse_m, only: read_reanalyse
     USE serre, ONLY: clat, clon  
     use tau2alpha_m, only: tau2alpha, dxdys  
23      use writefield_m, only: writefield      use writefield_m, only: writefield
24    
25      INTEGER, INTENT(IN):: itau      INTEGER, INTENT(IN):: itau
# Line 45  CONTAINS Line 34  CONTAINS
34    
35      ! Local:      ! Local:
36    
37      ! variables dynamiques pour les réanalyses      ! Variables dynamiques pour les réanalyses
38    
39      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)
40      ! vents covariants reanalyses      ! vents covariants r\'eanalyses
41    
42      REAL, save:: tetarea1(iim + 1, jjm + 1, llm) ! temp pot reales      REAL, save:: tetarea1(iim + 1, jjm + 1, llm)
43      REAL, save:: qrea1(iim + 1, jjm + 1, llm) ! temp pot reales      ! potential temperture from reanalysis
44    
45        REAL, save:: qrea1(iim + 1, jjm + 1, llm)
46    
47      REAL, save:: ucovrea2(iim + 1, jjm + 1, llm), vcovrea2(iim + 1, jjm, llm)      REAL, save:: ucovrea2(iim + 1, jjm + 1, llm), vcovrea2(iim + 1, jjm, llm)
48      ! vents covariants reanalyses      ! vents covariants reanalyses
49    
50      REAL, save:: tetarea2(iim + 1, jjm + 1, llm) ! temp pot reales      REAL, save:: tetarea2(iim + 1, jjm + 1, llm)
51      REAL, save:: qrea2(iim + 1, jjm + 1, llm) ! temp pot reales      ! potential temperture from reanalysis
52      REAL, save:: masserea2(ip1jmp1, llm) ! masse  
53        REAL, save:: qrea2(iim + 1, jjm + 1, llm)
     ! alpha determine la part des injections de donnees a chaque etape  
     ! alpha=1 signifie pas d'injection  
     ! alpha=0 signifie injection totale  
     REAL, save:: alpha_q(iim + 1, jjm + 1)  
     REAL, save:: alpha_t(iim + 1, jjm + 1)  
     REAL, save:: alpha_u(iim + 1, jjm + 1), alpha_v(iim + 1, jjm)  
   
     INTEGER, save:: step_rea, count_no_rea  
   
     INTEGER ilon, ilat  
     REAL factt ! pas de temps entre deux appels au guidage, en fraction de jour  
     real ztau(iim + 1, jjm + 1)  
54    
55      INTEGER ij, l      INTEGER l
     INTEGER ncid, dimid  
56      REAL tau      REAL tau
     INTEGER, SAVE:: nlev  
57    
58      ! TEST SUR QSAT      ! TEST SUR QSAT
59      REAL p(iim + 1, jjm + 1, llmp1)      REAL p(iim + 1, jjm + 1, llm + 1)
60      real pk(iim + 1, jjm + 1, llm), pks(iim + 1, jjm + 1)      real pk(iim + 1, jjm + 1, llm), pks(iim + 1, jjm + 1)
61      REAL qsat(iim + 1, jjm + 1, llm)      REAL qsat(iim + 1, jjm + 1, llm)
62    
63      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
64    
65      !!PRINT *, 'Call sequence information: guide'      IF (itau == 0) THEN
66           ! Lecture du premier état des réanalyses :
67      first_call: IF (itau == 0) THEN         CALL read_reanalyse(ps, ucovrea2, vcovrea2, tetarea2, qrea2)
        CALL conf_guide  
   
        IF (online) THEN  
           ! Constantes de temps de rappel en jour  
   
           ! coordonnees du centre du zoom  
           CALL coordij(clon, clat, ilon, ilat)  
           ! aire de la maille au centre du zoom  
           aire_min = aire(ilon+(ilat - 1) * iip1)  
           ! aire maximale de la maille  
           aire_max = 0.  
           DO ij = 1, ip1jmp1  
              aire_max = max(aire_max, aire(ij))  
           END DO  
   
           factt = dtvr * iperiod / daysec  
   
           CALL tau2alpha(3, factt, tau_min_v, tau_max_v, alpha_v)  
           CALL tau2alpha(2, factt, tau_min_u, tau_max_u, alpha_u)  
           CALL tau2alpha(1, factt, tau_min_t, tau_max_t, alpha_t)  
           CALL tau2alpha(1, factt, tau_min_q, tau_max_q, alpha_q)  
        ELSE  
           ! Cas où on force exactement par les variables analysées  
           alpha_t = 0.  
           alpha_u = 0.  
           alpha_v = 0.  
           alpha_q = 0.  
        END IF  
   
        step_rea = 1  
        count_no_rea = 0  
        ncid = -99  
   
        ! lecture d'un fichier netcdf pour determiner le nombre de niveaux  
        if (guide_u) call nf95_open('u.nc',Nf90_NOWRITe,ncid)  
        if (guide_v) call nf95_open('v.nc',nf90_nowrite,ncid)  
        if (guide_T) call nf95_open('T.nc',nf90_nowrite,ncid)  
        if (guide_Q) call nf95_open('hur.nc',nf90_nowrite, ncid)  
   
        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)  
        ! Lecture du premier etat des reanalyses.  
        CALL read_reanalyse(1, ps, ucovrea2, vcovrea2, tetarea2, qrea2, &  
             masserea2, nlev)  
68         qrea2 = max(qrea2, 0.1)         qrea2 = max(qrea2, 0.1)
     END IF first_call  
69    
70      ! IMPORTATION DES VENTS, PRESSION ET TEMPERATURE REELS:         if (ini_anal) then
71              IF (guide_u) ucov = ucovrea2
72              IF (guide_v) vcov = vcovrea2
73              IF (guide_t) teta = tetarea2
74    
75              IF (guide_q) then
76                 ! Calcul de l'humidité saturante :
77                 forall (l = 1: llm + 1) p(:, :, l) = ap(l) + bp(l) * ps
78                 CALL exner_hyb(ps, p, pks, pk)
79                 q = q_sat(pk * teta / cpp, preff * (pk / cpp)**(1. / kappa)) &
80                      * qrea2 * 0.01
81              end IF
82           end if
83        END IF
84    
85        ! Importation des vents, pression et temp\'erature r\'eels :
86    
87      ! Nudging fields are given 4 times per day:      ! Nudging fields are given 4 times per day:
88      IF (mod(itau, day_step / 4) == 0) THEN      IF (mod(itau, day_step / 4) == 0) THEN
# Line 150  CONTAINS Line 91  CONTAINS
91         tetarea1 = tetarea2         tetarea1 = tetarea2
92         qrea1 = qrea2         qrea1 = qrea2
93    
94         PRINT *, 'LECTURE REANALYSES, 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)  
95         qrea2 = max(qrea2, 0.1)         qrea2 = max(qrea2, 0.1)
96         factt = dtvr * iperiod / daysec  
97         ztau = factt / max(alpha_t, 1E-10)         if (guide_u) then
98         CALL writefield("aire", aire)            CALL writefield("ucov", ucov)
99         CALL writefield("dxdys", dxdys)            CALL writefield("ucovrea2", ucovrea2)
100         CALL writefield("alpha_u", alpha_u)         end if
101         CALL writefield("alpha_t", alpha_t)  
102         CALL writefield("ztau", ztau)         if (guide_t) then
103         CALL writefield("ucov", ucov)            CALL writefield("teta", teta)
104         CALL writefield("ucovrea2", ucovrea2)            CALL writefield("tetarea2", tetarea2)
105         CALL writefield("teta", teta)         end if
106         CALL writefield("tetarea2", tetarea2)  
107         CALL writefield("qrea2", qrea2)         if (guide_q) then
108         CALL writefield("q", q)            CALL writefield("qrea2", qrea2)
109      ELSE            CALL writefield("q", q)
110         count_no_rea = count_no_rea + 1         end if
111      END IF      END IF
112    
113      ! Guidage      ! Guidage
# Line 179  CONTAINS Line 116  CONTAINS
116    
117      ! x_gcm = a * x_gcm + (1 - a) * x_reanalyses      ! x_gcm = a * x_gcm + (1 - a) * x_reanalyses
118    
119      IF (guide_u) THEN      IF (guide_u) forall (l = 1: llm) ucov(:, :, l) = (1. - alpha_u) &
120         IF (itau == 0 .AND. ini_anal) then           * ucov(:, :, l) + alpha_u * ((1. - tau) * ucovrea1(:, :, l) + tau &
121            ucov = ucovrea1           * ucovrea2(:, :, l))
122         else  
123            forall (l = 1: llm) ucov(:, :, l) = (1. - alpha_u) * ucov(:, :, l) &      IF (guide_v) forall (l = 1: llm) vcov(:, :, l) = (1. - alpha_v) &
124                 + alpha_u * ((1. - tau) * ucovrea1(:, :, l) &           * vcov(:, :, l) + alpha_v * ((1. - tau) * vcovrea1(:, :, l) + tau &
125                 + tau * ucovrea2(:, :, l))           * vcovrea2(:, :, l))
126         end IF  
127      END IF      IF (guide_t) forall (l = 1: llm) teta(:, :, l) = (1. - alpha_t) &
128             * teta(:, :, l) + alpha_t * ((1. - tau) * tetarea1(:, :, l) + tau &
129      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  
130    
131      IF (guide_q) THEN      IF (guide_q) THEN
132         ! Calcul de l'humidité saturante :         ! Calcul de l'humidité saturante :
# Line 206  CONTAINS Line 135  CONTAINS
135         qsat = q_sat(pk * teta / cpp, preff * (pk / cpp)**(1. / kappa))         qsat = q_sat(pk * teta / cpp, preff * (pk / cpp)**(1. / kappa))
136    
137         ! humidité relative en % -> humidité spécifique         ! humidité relative en % -> humidité spécifique
138         IF (itau == 0 .AND. ini_anal) then         forall (l = 1: llm) q(:, :, l) = (1. - alpha_q) * q(:, :, l) &
139            q = qsat * qrea1 * 0.01              + alpha_q * (qsat(:, :, l) * ((1. - tau) * qrea1(:, :, l) &
140         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  
141      END IF      END IF
142    
143    END SUBROUTINE guide    END SUBROUTINE guide
Legend:
Removed from v.108  
changed lines
  Added in v.265
  ViewVC Help
Powered by ViewVC 1.1.21