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

revision 114 by guez, Fri Sep 19 11:41:35 2014 UTC revision 115 by guez, Fri Sep 19 17:36:20 2014 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 comgeom, ONLY: rlatu, rlatv
16      USE conf_gcm_m, ONLY: day_step, iperiod      USE conf_gcm_m, ONLY: day_step
17      use conf_guide_m, only: conf_guide, guide_u, guide_v, guide_t, guide_q, &      use conf_guide_m, only: guide_u, guide_v, guide_t, guide_q, ncep, &
18           ncep, ini_anal, tau_min_u, tau_max_u, tau_min_v, tau_max_v, &           ini_anal, tau_min_u, tau_max_u, tau_min_v, tau_max_v, tau_min_t, &
19           tau_min_t, tau_max_t, tau_min_q, tau_max_q, online           tau_max_t, tau_min_q, tau_max_q, online, factt
20      USE dimens_m, ONLY: iim, jjm, llm      USE dimens_m, ONLY: iim, jjm, llm
21      USE disvert_m, ONLY: ap, bp, preff, presnivs      USE disvert_m, ONLY: ap, bp, preff, presnivs
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
31      USE serre, ONLY: clat, clon      use serre, only: grossismx, grossismy
32      use tau2alpha_m, only: tau2alpha      use tau2alpha_m, only: tau2alpha
33      use writefield_m, only: writefield      use writefield_m, only: writefield
34    
# Line 69  CONTAINS Line 68  CONTAINS
68    
69      INTEGER, save:: step_rea, count_no_rea      INTEGER, save:: step_rea, count_no_rea
70    
71      INTEGER ilon, ilat      INTEGER l
     REAL factt ! pas de temps entre deux appels au guidage, en fraction de jour  
   
     INTEGER ij, l  
72      INTEGER ncid, dimid      INTEGER ncid, dimid
73      REAL tau      REAL tau
74      INTEGER, SAVE:: nlev      INTEGER, SAVE:: nlev
# Line 82  CONTAINS Line 78  CONTAINS
78      real pk(iim + 1, jjm + 1, llm), pks(iim + 1, jjm + 1)      real pk(iim + 1, jjm + 1, llm), pks(iim + 1, jjm + 1)
79      REAL qsat(iim + 1, jjm + 1, llm)      REAL qsat(iim + 1, jjm + 1, llm)
80    
81        REAL dxdys(iip1, jjp1), dxdyu(iip1, jjp1), dxdyv(iip1, jjm)
82    
83      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
84    
85      !!PRINT *, 'Call sequence information: guide'      !!PRINT *, 'Call sequence information: guide'
86    
87      first_call: IF (itau == 0) THEN      first_call: IF (itau == 0) THEN
        CALL conf_guide  
   
88         IF (online) THEN         IF (online) THEN
89            ! Constantes de temps de rappel en jour            IF (abs(grossismx - 1.) < 0.1 .OR. abs(grossismy - 1.) < 0.1) THEN
90                 ! grille regulière
91            ! coordonnees du centre du zoom               if (guide_u) alpha_u = factt / tau_max_u
92            CALL coordij(clon, clat, ilon, ilat)               if (guide_v) alpha_v = factt / tau_max_v
93            ! aire de la maille au centre du zoom               if (guide_t) alpha_t = factt / tau_max_t
94            aire_min = aire(ilon+(ilat - 1) * iip1)               if (guide_q) alpha_q = factt / tau_max_q
95            ! aire maximale de la maille            else
96            aire_max = 0.               call init_tau2alpha(dxdys, dxdyu, dxdyv)
97            DO ij = 1, ip1jmp1  
98               aire_max = max(aire_max, aire(ij))               if (guide_u) then
99            END DO                  CALL tau2alpha(dxdyu, rlatu, tau_min_u, tau_max_u, alpha_u)
100                    CALL writefield("alpha_u", alpha_u)
101            factt = dtvr * iperiod / daysec               end if
102    
103            if (guide_u) CALL tau2alpha(3, factt, tau_min_v, tau_max_v, alpha_v)               if (guide_v) then
104            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)
105            if (guide_t) CALL tau2alpha(1, factt, tau_min_t, tau_max_t, alpha_t)                  CALL writefield("alpha_v", alpha_v)
106            if (guide_q) CALL tau2alpha(1, factt, tau_min_q, tau_max_q, alpha_q)               end if
107    
108                 if (guide_t) then
109                    CALL tau2alpha(dxdys, rlatu, tau_min_t, tau_max_t, alpha_t)
110                    CALL writefield("alpha_t", alpha_t)
111                 end if
112    
113                 if (guide_q)  then
114                    CALL tau2alpha(dxdys, rlatu, tau_min_q, tau_max_q, alpha_q)
115                    CALL writefield("alpha_q", alpha_q)
116                 end if
117              end IF
118         ELSE         ELSE
119            ! Cas où on force exactement par les variables analysées            ! Cas où on force exactement par les variables analysées
120            if (guide_u) alpha_t = 1.            if (guide_u) alpha_u = 1.
121            if (guide_v) alpha_u = 1.            if (guide_v) alpha_v = 1.
122            if (guide_t) alpha_v = 1.            if (guide_t) alpha_t = 1.
123            if (guide_q) alpha_q = 1.            if (guide_q) alpha_q = 1.
124         END IF         END IF
125    
126         step_rea = 1         step_rea = 1
127         count_no_rea = 0         count_no_rea = 0
128    
129         ! lecture d'un fichier netcdf pour determiner le nombre de niveaux         ! lecture d'un fichier netcdf pour determiner le nombre de niveaux :
130    
131         if (guide_u) then         if (guide_u) then
132            call nf95_open('u.nc',Nf90_NOWRITe,ncid)            call nf95_open('u.nc',Nf90_NOWRITe,ncid)
133         else if (guide_v) then         else if (guide_v) then
# Line 136  CONTAINS Line 144  CONTAINS
144            call nf95_inq_dimid(ncid, 'PRESSURE', dimid)            call nf95_inq_dimid(ncid, 'PRESSURE', dimid)
145         END IF         END IF
146         call nf95_inquire_dimension(ncid, dimid, nclen=nlev)         call nf95_inquire_dimension(ncid, dimid, nclen=nlev)
147         PRINT *, 'nlev', nlev         PRINT *, 'nlev = ', nlev
148         call nf95_close(ncid)         call nf95_close(ncid)
149         ! Lecture du premier etat des reanalyses.  
150           ! Lecture du premier état des réanalyses :
151         CALL read_reanalyse(1, ps, ucovrea2, vcovrea2, tetarea2, qrea2, &         CALL read_reanalyse(1, ps, ucovrea2, vcovrea2, tetarea2, qrea2, &
152              masserea2, nlev)              masserea2, nlev)
153         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)  
154      END IF first_call      END IF first_call
155    
156      ! IMPORTATION DES VENTS, PRESSION ET TEMPERATURE REELS:      ! IMPORTATION DES VENTS, PRESSION ET TEMPERATURE REELS:
# Line 162  CONTAINS Line 168  CONTAINS
168         CALL read_reanalyse(step_rea, ps, ucovrea2, vcovrea2, tetarea2, qrea2, &         CALL read_reanalyse(step_rea, ps, ucovrea2, vcovrea2, tetarea2, qrea2, &
169              masserea2, nlev)              masserea2, nlev)
170         qrea2 = max(qrea2, 0.1)         qrea2 = max(qrea2, 0.1)
        factt = dtvr * iperiod / daysec  
171    
172         if (guide_u) then         if (guide_u) then
173            CALL writefield("ucov", ucov)            CALL writefield("ucov", ucov)
Legend:
Removed from v.114  
changed lines
  Added in v.115
  ViewVC Help
Powered by ViewVC 1.1.21