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

trunk/dyn3d/Guide/guide.f revision 114 by guez, Fri Sep 19 11:41:35 2014 UTC trunk/Sources/dyn3d/Guide/guide.f revision 171 by guez, Tue Sep 29 19:48:59 2015 UTC
# Line 5  MODULE guide_m Line 5  MODULE guide_m
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, ncep, &
17      use conf_guide_m, only: conf_guide, guide_u, guide_v, guide_t, guide_q, &           ini_anal, tau_min_u, tau_max_u, tau_min_v, tau_max_v, tau_min_t, &
18           ncep, ini_anal, tau_min_u, tau_max_u, tau_min_v, tau_max_v, &           tau_max_t, tau_min_q, tau_max_q, online, factt
          tau_min_t, tau_max_t, tau_min_q, tau_max_q, online  
19      USE dimens_m, ONLY: iim, jjm, llm      USE dimens_m, ONLY: iim, jjm, llm
20      USE disvert_m, ONLY: ap, bp, preff, presnivs      USE disvert_m, ONLY: ap, bp, preff
21        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
24      use netcdf, only: nf90_nowrite      use netcdf, only: nf90_nowrite
25      use netcdf95, only: nf95_close, nf95_inq_dimid, nf95_inquire_dimension, &      use netcdf95, only: nf95_close, nf95_inq_dimid, nf95_inquire_dimension, &
26           nf95_open           nf95_open
# Line 29  CONTAINS Line 28  CONTAINS
28      USE paramet_m, ONLY: iip1, ip1jmp1, jjp1, llmp1      USE paramet_m, ONLY: iip1, ip1jmp1, jjp1, llmp1
29      USE q_sat_m, ONLY: q_sat      USE q_sat_m, ONLY: q_sat
30      use read_reanalyse_m, only: read_reanalyse      use read_reanalyse_m, only: read_reanalyse
     USE serre, ONLY: clat, clon  
31      use tau2alpha_m, only: tau2alpha      use tau2alpha_m, only: tau2alpha
32      use writefield_m, only: writefield      use writefield_m, only: writefield
33    
# Line 60  CONTAINS Line 58  CONTAINS
58      REAL, save:: qrea2(iim + 1, jjm + 1, llm) ! temp pot reales      REAL, save:: qrea2(iim + 1, jjm + 1, llm) ! temp pot reales
59      REAL, save:: masserea2(ip1jmp1, llm) ! masse      REAL, save:: masserea2(ip1jmp1, llm) ! masse
60    
61      ! alpha determine la part des injections de donnees a chaque etape      ! alpha détermine la part des injections de données à chaque étape
62      ! alpha=0 signifie pas d'injection      ! alpha=0 signifie pas d'injection
63      ! alpha=1 signifie injection totale      ! alpha=1 signifie injection totale
64      REAL, save:: alpha_q(iim + 1, jjm + 1)      REAL, save:: alpha_q(iim + 1, jjm + 1)
# Line 69  CONTAINS Line 67  CONTAINS
67    
68      INTEGER, save:: step_rea, count_no_rea      INTEGER, save:: step_rea, count_no_rea
69    
70      INTEGER ilon, ilat      INTEGER l
     REAL factt ! pas de temps entre deux appels au guidage, en fraction de jour  
   
     INTEGER ij, l  
71      INTEGER ncid, dimid      INTEGER ncid, dimid
72      REAL tau      REAL tau
73      INTEGER, SAVE:: nlev      INTEGER, SAVE:: nlev
# Line 82  CONTAINS Line 77  CONTAINS
77      real pk(iim + 1, jjm + 1, llm), pks(iim + 1, jjm + 1)      real pk(iim + 1, jjm + 1, llm), pks(iim + 1, jjm + 1)
78      REAL qsat(iim + 1, jjm + 1, llm)      REAL qsat(iim + 1, jjm + 1, llm)
79    
80        REAL dxdys(iip1, jjp1), dxdyu(iip1, jjp1), dxdyv(iip1, jjm)
81    
82      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
83    
84      !!PRINT *, 'Call sequence information: guide'      !!PRINT *, 'Call sequence information: guide'
85    
86      first_call: IF (itau == 0) THEN      first_call: IF (itau == 0) THEN
        CALL conf_guide  
   
87         IF (online) THEN         IF (online) THEN
88            ! Constantes de temps de rappel en jour            IF (abs(grossismx - 1.) < 0.1 .OR. abs(grossismy - 1.) < 0.1) THEN
89                 ! grille regulière
90            ! coordonnees du centre du zoom               if (guide_u) alpha_u = factt / tau_max_u
91            CALL coordij(clon, clat, ilon, ilat)               if (guide_v) alpha_v = factt / tau_max_v
92            ! aire de la maille au centre du zoom               if (guide_t) alpha_t = factt / tau_max_t
93            aire_min = aire(ilon+(ilat - 1) * iip1)               if (guide_q) alpha_q = factt / tau_max_q
94            ! aire maximale de la maille            else
95            aire_max = 0.               call init_tau2alpha(dxdys, dxdyu, dxdyv)
96            DO ij = 1, ip1jmp1  
97               aire_max = max(aire_max, aire(ij))               if (guide_u) then
98            END DO                  CALL tau2alpha(dxdyu, rlatu, tau_min_u, tau_max_u, alpha_u)
99                    CALL writefield("alpha_u", alpha_u)
100            factt = dtvr * iperiod / daysec               end if
101    
102            if (guide_u) CALL tau2alpha(3, factt, tau_min_v, tau_max_v, alpha_v)               if (guide_v) then
103            if (guide_v) CALL tau2alpha(2, factt, tau_min_u, tau_max_u, alpha_u)                  CALL tau2alpha(dxdyv, rlatv, tau_min_v, tau_max_v, alpha_v)
104            if (guide_t) CALL tau2alpha(1, factt, tau_min_t, tau_max_t, alpha_t)                  CALL writefield("alpha_v", alpha_v)
105            if (guide_q) CALL tau2alpha(1, factt, tau_min_q, tau_max_q, alpha_q)               end if
106    
107                 if (guide_t) then
108                    CALL tau2alpha(dxdys, rlatu, tau_min_t, tau_max_t, alpha_t)
109                    CALL writefield("alpha_t", alpha_t)
110                 end if
111    
112                 if (guide_q)  then
113                    CALL tau2alpha(dxdys, rlatu, tau_min_q, tau_max_q, alpha_q)
114                    CALL writefield("alpha_q", alpha_q)
115                 end if
116              end IF
117         ELSE         ELSE
118            ! Cas où on force exactement par les variables analysées            ! Cas où on force exactement par les variables analysées
119            if (guide_u) alpha_t = 1.            if (guide_u) alpha_u = 1.
120            if (guide_v) alpha_u = 1.            if (guide_v) alpha_v = 1.
121            if (guide_t) alpha_v = 1.            if (guide_t) alpha_t = 1.
122            if (guide_q) alpha_q = 1.            if (guide_q) alpha_q = 1.
123         END IF         END IF
124    
125         step_rea = 1         step_rea = 1
126         count_no_rea = 0         count_no_rea = 0
127    
128         ! lecture d'un fichier netcdf pour determiner le nombre de niveaux         ! Lecture d'un fichier NetCDF pour d\'eterminer le nombre de niveaux :
129    
130         if (guide_u) then         if (guide_u) then
131            call nf95_open('u.nc',Nf90_NOWRITe,ncid)            call nf95_open('u.nc',Nf90_NOWRITe,ncid)
132         else if (guide_v) then         else if (guide_v) then
# Line 136  CONTAINS Line 143  CONTAINS
143            call nf95_inq_dimid(ncid, 'PRESSURE', dimid)            call nf95_inq_dimid(ncid, 'PRESSURE', dimid)
144         END IF         END IF
145         call nf95_inquire_dimension(ncid, dimid, nclen=nlev)         call nf95_inquire_dimension(ncid, dimid, nclen=nlev)
146         PRINT *, 'nlev', nlev         PRINT *, 'nlev = ', nlev
147         call nf95_close(ncid)         call nf95_close(ncid)
148         ! Lecture du premier etat des reanalyses.  
149           ! Lecture du premier état des réanalyses :
150         CALL read_reanalyse(1, ps, ucovrea2, vcovrea2, tetarea2, qrea2, &         CALL read_reanalyse(1, ps, ucovrea2, vcovrea2, tetarea2, qrea2, &
151              masserea2, nlev)              masserea2, nlev)
152         qrea2 = max(qrea2, 0.1)         qrea2 = max(qrea2, 0.1)
   
        if (guide_u) CALL writefield("alpha_u", alpha_u)  
        if (guide_t) CALL writefield("alpha_t", alpha_t)  
153      END IF first_call      END IF first_call
154    
155      ! IMPORTATION DES VENTS, PRESSION ET TEMPERATURE REELS:      ! IMPORTATION DES VENTS, PRESSION ET TEMPERATURE REELS:
# Line 156  CONTAINS Line 161  CONTAINS
161         tetarea1 = tetarea2         tetarea1 = tetarea2
162         qrea1 = qrea2         qrea1 = qrea2
163    
164         PRINT *, 'LECTURE REANALYSES, pas ', step_rea, 'apres ', &         PRINT *, 'Lecture fichiers guidage, pas ', step_rea, 'apres ', &
165              count_no_rea, ' non lectures'              count_no_rea, ' non lectures'
166         step_rea = step_rea + 1         step_rea = step_rea + 1
167         CALL read_reanalyse(step_rea, ps, ucovrea2, vcovrea2, tetarea2, qrea2, &         CALL read_reanalyse(step_rea, ps, ucovrea2, vcovrea2, tetarea2, qrea2, &
168              masserea2, nlev)              masserea2, nlev)
169         qrea2 = max(qrea2, 0.1)         qrea2 = max(qrea2, 0.1)
        factt = dtvr * iperiod / daysec  
170    
171         if (guide_u) then         if (guide_u) then
172            CALL writefield("ucov", ucov)            CALL writefield("ucov", ucov)
Legend:
Removed from v.114  
changed lines
  Added in v.171
  ViewVC Help
Powered by ViewVC 1.1.21