/[lmdze]/trunk/Sources/dyn3d/Guide/Read_reanalyse/read_reanalyse.f
ViewVC logotype

Diff of /trunk/Sources/dyn3d/Guide/Read_reanalyse/read_reanalyse.f

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

trunk/dyn3d/Read_reanalyse/read_reanalyse.f revision 88 by guez, Tue Mar 11 15:09:02 2014 UTC trunk/Sources/dyn3d/Guide/Read_reanalyse/read_reanalyse.f revision 178 by guez, Fri Mar 11 18:47:26 2016 UTC
# Line 4  module read_reanalyse_m Line 4  module read_reanalyse_m
4    
5  contains  contains
6    
7    subroutine read_reanalyse(timestep, psi, u, v, t, q, masse, nlevnc)    subroutine read_reanalyse(psi, u, v, t, q)
8    
9      ! From LMDZ4/libf/dyn3d/read_reanalyse.F, version 1.3, 2005/04/15 12:31:21      ! From LMDZ4/libf/dyn3d/read_reanalyse.F, version 1.3, 2005/04/15 12:31:21
10    
11      USE conf_guide_m, ONLY: guide_q, guide_t, guide_u, guide_v, ncep      USE conf_guide_m, ONLY: guide_q, guide_t, guide_u, guide_v
12      USE dimens_m, ONLY: iim, jjm, llm      USE dimens_m, ONLY: jjm, llm
13      USE netcdf, ONLY: nf90_get_var, nf90_inq_varid, nf90_nowrite, nf90_open      use nat2gcm_m, only: nat2gcm
14        USE netcdf, ONLY: nf90_nowrite
15        USE netcdf95, ONLY: nf95_get_var, nf95_inq_varid, nf95_inquire_dimension, &
16             nf95_open, find_coord
17      USE paramet_m, ONLY: iip1, jjp1      USE paramet_m, ONLY: iip1, jjp1
18      use reanalyse2nat_m, only: reanalyse2nat      use reanalyse2nat_m, only: reanalyse2nat
19    
20      integer timestep      real, intent(in):: psi(:, :) ! (iip1, jjp1)
21      real, intent(in):: psi(iip1, jjp1)      real, intent(out):: u(:, :, :) ! (iip1, jjp1, llm)
22      real u(iip1, jjp1, llm), v(iip1, jjm, llm)      real, intent(out):: v(:, :, :) ! (iip1, jjm, llm)
23      real t(iip1, jjp1, llm), q(iip1, jjp1, llm)      real, intent(out):: t(:, :, :), q(:, :, :) ! (iip1, jjp1, llm)
     real masse(iip1, jjp1, llm)  
     integer nlevnc  
24    
25      ! Local:      ! Local:
26        integer nlevnc
27      integer l      integer:: timestep = 0
28      real pk(iip1, jjp1, llm)      real pk(iip1, jjp1, llm)
29      integer, save:: ncidu, varidu, ncidv, varidv, ncidt, varidt      integer, save:: ncidu, varidu, ncidv, varidv, ncidt, varidt, ncidQ, varidQ
30      integer, save:: ncidpl      integer ncid, varid, dimid
31      integer, save:: varidpl, ncidQ, varidQ      real, allocatable, save:: unc(:, :, :) ! (iip1, jjp1, nlevnc)
32      real unc(iip1, jjp1, nlevnc), vnc(iip1, jjm, nlevnc)      real, allocatable, save:: vnc(:, :, :) ! (iip1, jjm, nlevnc)
33      real tnc(iip1, jjp1, nlevnc)      real, allocatable, save:: tnc(:, :, :), Qnc(:, :, :) ! (iip1, jjp1, nlevnc)
34      real Qnc(iip1, jjp1, nlevnc)      real, allocatable, save:: pl(:) ! (nlevnc)
35      real pl(nlevnc)      real latitude(jjm + 1)
     integer start(4), count(4), status  
     real rcode  
36      logical:: first = .true.      logical:: first = .true.
37        logical, save:: invert_y
38    
39      ! -----------------------------------------------------------------      ! -----------------------------------------------------------------
40    
41      !   Initialisation de la lecture des fichiers      ! Initialisation de la lecture des fichiers
42    
43      if (first) then      if (first) then
44         ncidpl=-99         print *, 'Intitialisation de read reanalyse'
        print *, 'Intitialisation de read reanalsye'  
45    
46         ! Vent zonal         ! Vent zonal
47         if (guide_u) then         if (guide_u) then
48            rcode=nf90_open('u.nc', nf90_nowrite, ncidu)            call nf95_open('u.nc', nf90_nowrite, ncidu)
49            rcode = nf90_inq_varid(ncidu, 'UWND', varidu)            call nf95_inq_varid(ncidu, 'UWND', varidu)
           print *, 'ncidu, varidu', ncidu, varidu  
           if (ncidpl.eq.-99) ncidpl=ncidu  
50         endif         endif
51    
52         ! Vent meridien         ! Vent meridien
53         if (guide_v) then         if (guide_v) then
54            rcode=nf90_open('v.nc', nf90_nowrite, ncidv)            call nf95_open('v.nc', nf90_nowrite, ncidv)
55            rcode = nf90_inq_varid(ncidv, 'VWND', varidv)            call nf95_inq_varid(ncidv, 'VWND', varidv)
           print *, 'ncidv, varidv', ncidv, varidv  
           if (ncidpl.eq.-99) ncidpl=ncidv  
56         endif         endif
57    
58         ! Temperature         ! Temperature
59         if (guide_T) then         if (guide_T) then
60            rcode=nf90_open('T.nc', nf90_nowrite, ncidt)            call nf95_open('T.nc', nf90_nowrite, ncidt)
61            rcode = nf90_inq_varid(ncidt, 'AIR', varidt)            call nf95_inq_varid(ncidt, 'AIR', varidt)
           print *, 'ncidt, varidt', ncidt, varidt  
           if (ncidpl.eq.-99) ncidpl=ncidt  
62         endif         endif
63    
64         ! Humidite         ! Humidite
65         if (guide_Q) then         if (guide_Q) then
66            rcode=nf90_open('hur.nc', nf90_nowrite, ncidQ)            call nf95_open('hur.nc', nf90_nowrite, ncidQ)
67            rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)            call nf95_inq_varid(ncidQ, 'RH', varidQ)
           print *, 'ncidQ, varidQ', ncidQ, varidQ  
           if (ncidpl.eq.-99) ncidpl=ncidQ  
68         endif         endif
69    
70         ! Coordonnee verticale         ! Coordonn\'ee verticale :
        if (ncep) then  
           print *, 'Vous etes entrain de lire des donnees NCEP'  
           rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)  
        else  
           print *, 'Vous etes entrain de lire des donnees ECMWF'  
           rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)  
        endif  
        print *, 'ncidu, varidpl', ncidu, varidpl  
     endif  
     print *, 'ok1'  
71    
72      ! Niveaux de pression         if (guide_u) then
73      print *, 'WARNING!!! Il n y a pas de test de coherence'            ncid = ncidu
74      print *, 'sur le nombre de niveaux verticaux dans le fichier nc'         else if (guide_v) then
75      status=NF90_GET_VAR(ncidpl, varidpl, pl)            ncid = ncidv
76      !  passage en pascal         else if (guide_T) then
77      pl(:)=100.*pl(:)            ncid = ncidt
78      if (first) then         else
79         do l=1, nlevnc            ncid = ncidq
80            print *, 'PL(', l, ')=', pl(l)         end if
        enddo  
     endif  
   
     !   lecture des champs u, v, T  
   
     !  dimensions pour les champs scalaires et le vent zonal  
81    
82      start(1)=1         call find_coord(ncid, dimid = dimid, varid = varid, std_name = "plev")
83      start(2)=1         call nf95_inquire_dimension(ncid, dimid, nclen = nlevnc)
84      start(3)=1         PRINT *, 'nlevnc = ', nlevnc
85      start(4)=timestep         allocate(unc(iip1, jjp1, nlevnc), vnc(iip1, jjm, nlevnc))
86           allocate(tnc(iip1, jjp1, nlevnc), Qnc(iip1, jjp1, nlevnc), pl(nlevnc))
87           call NF95_GET_VAR(ncid, varid, pl)
88           pl = 100. * pl ! passage en pascal
89    
90      count(1)=iip1         ! Read latitude values just to know their order:
91      count(2)=jjp1         call find_coord(ncid, varid = varid, std_name = "latitude")
92      count(3)=nlevnc         call nf95_get_var(ncid, varid, latitude)
93      count(4)=1         invert_y = latitude(1) < latitude(2)
94    
95      ! mise a zero des tableaux         first = .false.
96        endif
97    
98      unc(:, :, :)=0.      ! lecture des champs u, v, T, q
     vnc(:, :, :)=0.  
     tnc(:, :, :)=0.  
     Qnc(:, :, :)=0.  
99    
100      !  Vent zonal      timestep = timestep + 1
101    
102        ! Vent zonal
103      if (guide_u) then      if (guide_u) then
104         print *, 'avant la lecture de UNCEP nd de niv:', nlevnc         call NF95_GET_VAR(ncidu, varidu, unc, start = (/1, 1, 1, timestep/))
105         status=NF90_GET_VAR(ncidu, varidu, unc, start, count)      else
106         print *, 'WARNING!!! Correction bidon pour palier a un '         unc = 0.
107         print *, 'probleme dans la creation des fichiers nc'      end if
        call correctbid(iim, jjp1*nlevnc, unc)  
        call dump2d(iip1, jjp1, unc, 'UNC COUCHE 1 ')  
     endif  
   
     !  Temperature  
108    
109      print *, 'ncidt=', ncidt, 'varidt=', varidt, 'start=', start      ! Temperature
     print *, 'count=', count  
110      if (guide_T) then      if (guide_T) then
111         status=NF90_GET_VAR(ncidt, varidt, tnc, start, count)         call NF95_GET_VAR(ncidt, varidt, tnc, start = (/1, 1, 1, timestep/))
112         call dump2d(iip1, jjp1, tnc, 'TNC COUCHE 1 AAA ')      else
113         call correctbid(iim, jjp1*nlevnc, tnc)         tnc = 0.
114         call dump2d(iip1, jjp1, tnc, 'TNC COUCHE 1 BBB ')      end if
     endif  
   
     !  Humidite  
115    
116        ! Humidite
117      if (guide_Q) then      if (guide_Q) then
118         status=NF90_GET_VAR(ncidQ, varidQ, Qnc, start, count)         call NF95_GET_VAR(ncidQ, varidQ, Qnc, start = (/1, 1, 1, timestep/))
119         call correctbid(iim, jjp1*nlevnc, Qnc)      else
120         call dump2d(iip1, jjp1, Qnc, 'QNC COUCHE 1 ')         Qnc = 0.
121      endif      end if
   
     count(2)=jjm  
     !  Vent meridien  
122    
123        ! Vent meridien
124      if (guide_v) then      if (guide_v) then
125         status=NF90_GET_VAR(ncidv, varidv, vnc, start, count)         call NF95_GET_VAR(ncidv, varidv, vnc, start = (/1, 1, 1, timestep/))
126         call correctbid(iim, jjm*nlevnc, vnc)      else
127         call dump2d(iip1, jjm, vnc, 'VNC COUCHE 1 ')         vnc = 0.
128      endif      end if
   
     start(3)=timestep  
     start(4)=0  
     count(2)=jjp1  
     count(3)=1  
     count(4)=0  
   
     !  Interpolation verticale sur les niveaux modele  
   
     call reanalyse2nat(nlevnc, psi, unc, vnc, tnc, Qnc, pl, u, v, t, Q, &  
          masse, pk)  
   
     call dump2d(iip1, jjm, v, 'V COUCHE APRES ')  
   
     !  Passage aux variables du modele (vents covariants, temperature  
     !  potentielle et humidite specifique)  
129    
130      call nat2gcm(u, v, t, Q, pk, u, v, t, Q)      call reanalyse2nat(invert_y, psi, unc, vnc, tnc, Qnc, pl, u, v, t, Q, pk)
131      print *, 'TIMESTEP ', timestep      call nat2gcm(pk, u, v, t)
     first=.false.  
132    
133    end subroutine read_reanalyse    end subroutine read_reanalyse
134    
Legend:
Removed from v.88  
changed lines
  Added in v.178
  ViewVC Help
Powered by ViewVC 1.1.21