/[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/dyn3d/guide.f revision 109 by guez, Wed Sep 17 10:08:00 2014 UTC trunk/dyn3d/Guide/guide.f revision 254 by guez, Mon Feb 5 10:39:38 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
          ncep, ini_anal, tau_min_u, tau_max_u, tau_min_v, tau_max_v, &  
          tau_min_t, tau_max_t, tau_min_q, tau_max_q, online  
18      USE dimens_m, ONLY: iim, jjm, llm      USE dimens_m, ONLY: iim, jjm, llm
19      USE disvert_m, ONLY: ap, bp, preff, presnivs      USE disvert_m, ONLY: ap, bp, preff
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  
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
     REAL, save:: masserea2(ip1jmp1, llm) ! masse  
   
     ! 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  
52    
53      INTEGER ilon, ilat      REAL, save:: qrea2(iim + 1, jjm + 1, llm)
     REAL factt ! pas de temps entre deux appels au guidage, en fraction de jour  
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)
69    
70         CALL writefield("alpha_u", alpha_u)         if (ini_anal) then
71         CALL writefield("alpha_t", alpha_t)            IF (guide_u) ucov = ucovrea2
72      END IF first_call            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 TEMPERATURE REELS:      ! 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 152  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         CALL writefield("ucov", ucov)         if (guide_u) then
98         CALL writefield("ucovrea2", ucovrea2)            CALL writefield("ucov", ucov)
99         CALL writefield("teta", teta)            CALL writefield("ucovrea2", ucovrea2)
100         CALL writefield("tetarea2", tetarea2)         end if
101         CALL writefield("qrea2", qrea2)  
102         CALL writefield("q", q)         if (guide_t) then
103      ELSE            CALL writefield("teta", teta)
104         count_no_rea = count_no_rea + 1            CALL writefield("tetarea2", tetarea2)
105           end if
106    
107           if (guide_q) then
108              CALL writefield("qrea2", qrea2)
109              CALL writefield("q", q)
110           end if
111      END IF      END IF
112    
113      ! Guidage      ! Guidage
# Line 175  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 202  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.109  
changed lines
  Added in v.254
  ViewVC Help
Powered by ViewVC 1.1.21