/[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/libf/dyn3d/Read_reanalyse/read_reanalyse.f90 revision 44 by guez, Wed Apr 13 12:29:18 2011 UTC trunk/dyn3d/Read_reanalyse/read_reanalyse.f revision 88 by guez, Tue Mar 11 15:09:02 2014 UTC
# Line 1  Line 1 
1        subroutine read_reanalyse(timestep,psi &  module read_reanalyse_m
          ,u,v,t,q,masse,ps,mode,nlevnc)  
2    
3  !    IMPLICIT NONE
4  ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/read_reanalyse.F,v 1.3 2005/04/15 12:31:21 lmdzadmin Exp $  
5  !  contains
6  !  
7  !    subroutine read_reanalyse(timestep, psi, u, v, t, q, masse, nlevnc)
8  !   mode=0 variables naturelles  
9  !   mode=1 variabels GCM      ! 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
12  !   Declarations      USE dimens_m, ONLY: iim, jjm, llm
13  ! -----------------------------------------------------------------      USE netcdf, ONLY: nf90_get_var, nf90_inq_varid, nf90_nowrite, nf90_open
14        use dimens_m      USE paramet_m, ONLY: iip1, jjp1
15        use paramet_m      use reanalyse2nat_m, only: reanalyse2nat
16        use comvert  
17        use comgeom      integer timestep
18        use conf_guide_m      real, intent(in):: psi(iip1, jjp1)
19        use netcdf      real u(iip1, jjp1, llm), v(iip1, jjm, llm)
20        real t(iip1, jjp1, llm), q(iip1, jjp1, llm)
21        IMPLICIT NONE      real masse(iip1, jjp1, llm)
22        integer nlevnc
23  ! common  
24  ! ------      ! Local:
25    
26        include "netcdf.inc"      integer l
27        real pk(iip1, jjp1, llm)
28        integer, save:: ncidu, varidu, ncidv, varidv, ncidt, varidt
29  ! arguments      integer, save:: ncidpl
30  ! ---------      integer, save:: varidpl, ncidQ, varidQ
31        integer nlevnc      real unc(iip1, jjp1, nlevnc), vnc(iip1, jjm, nlevnc)
32        integer timestep,mode,l      real tnc(iip1, jjp1, nlevnc)
33        real Qnc(iip1, jjp1, nlevnc)
34        real psi(iip1,jjp1)      real pl(nlevnc)
35        real u(iip1,jjp1,llm),v(iip1,jjm,llm)      integer start(4), count(4), status
36        real t(iip1,jjp1,llm),ps(iip1,jjp1),q(iip1,jjp1,llm)      real rcode
37        real masse(iip1,jjp1,llm),pk(iip1,jjp1,llm)      logical:: first = .true.
38    
39        ! -----------------------------------------------------------------
40  ! local  
41  ! -----      !   Initialisation de la lecture des fichiers
42        integer ncidu,varidu,ncidv,varidv,ncidt,varidt,ncidps,varidps  
43        integer ncidpl      if (first) then
44        integer varidpl,ncidQ,varidQ         ncidpl=-99
45        save ncidu,varidu,ncidv,varidv,ncidt,varidt,ncidps,varidps         print *, 'Intitialisation de read reanalsye'
46        save ncidpl  
47        save varidpl,ncidQ,varidQ         ! Vent zonal
48           if (guide_u) then
49        real unc(iip1,jjp1,nlevnc),vnc(iip1,jjm,nlevnc)            rcode=nf90_open('u.nc', nf90_nowrite, ncidu)
50        real tnc(iip1,jjp1,nlevnc),psnc(iip1,jjp1)            rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
51        real Qnc(iip1,jjp1,nlevnc)            print *, 'ncidu, varidu', ncidu, varidu
52        real pl(nlevnc)            if (ncidpl.eq.-99) ncidpl=ncidu
53           endif
54        integer start(4),count(4),status  
55           ! Vent meridien
56        real rcode         if (guide_v) then
57        logical first            rcode=nf90_open('v.nc', nf90_nowrite, ncidv)
58        save first            rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
59              print *, 'ncidv, varidv', ncidv, varidv
60        data first/.true./            if (ncidpl.eq.-99) ncidpl=ncidv
61           endif
62    
63           ! Temperature
64  ! -----------------------------------------------------------------         if (guide_T) then
65  !   Initialisation de la lecture des fichiers            rcode=nf90_open('T.nc', nf90_nowrite, ncidt)
66  ! -----------------------------------------------------------------            rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
67        if (first) then            print *, 'ncidt, varidt', ncidt, varidt
68             ncidpl=-99            if (ncidpl.eq.-99) ncidpl=ncidt
69             print*,'Intitialisation de read reanalsye'         endif
70    
71  ! Vent zonal         ! Humidite
72              if (guide_u) then         if (guide_Q) then
73              rcode=nf90_open('u.nc',nf90_nowrite,ncidu)            rcode=nf90_open('hur.nc', nf90_nowrite, ncidQ)
74              rcode = nf90_inq_varid(ncidu, 'UWND', varidu)            rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
75              print*,'ncidu,varidu',ncidu,varidu            print *, 'ncidQ, varidQ', ncidQ, varidQ
76              if (ncidpl.eq.-99) ncidpl=ncidu            if (ncidpl.eq.-99) ncidpl=ncidQ
77              endif         endif
78    
79  ! Vent meridien         ! Coordonnee verticale
80              if (guide_v) then         if (ncep) then
81              rcode=nf90_open('v.nc',nf90_nowrite,ncidv)            print *, 'Vous etes entrain de lire des donnees NCEP'
82              rcode = nf90_inq_varid(ncidv, 'VWND', varidv)            rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
83              print*,'ncidv,varidv',ncidv,varidv         else
84              if (ncidpl.eq.-99) ncidpl=ncidv            print *, 'Vous etes entrain de lire des donnees ECMWF'
85              endif            rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
86           endif
87  ! Temperature         print *, 'ncidu, varidpl', ncidu, varidpl
88              if (guide_T) then      endif
89              rcode=nf90_open('T.nc',nf90_nowrite,ncidt)      print *, 'ok1'
90              rcode = nf90_inq_varid(ncidt, 'AIR', varidt)  
91              print*,'ncidt,varidt',ncidt,varidt      ! Niveaux de pression
92              if (ncidpl.eq.-99) ncidpl=ncidt      print *, 'WARNING!!! Il n y a pas de test de coherence'
93              endif      print *, 'sur le nombre de niveaux verticaux dans le fichier nc'
94        status=NF90_GET_VAR(ncidpl, varidpl, pl)
95  ! Humidite      !  passage en pascal
96              if (guide_Q) then      pl(:)=100.*pl(:)
97              rcode=nf90_open('hur.nc',nf90_nowrite,ncidQ)      if (first) then
98              rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)         do l=1, nlevnc
99              print*,'ncidQ,varidQ',ncidQ,varidQ            print *, 'PL(', l, ')=', pl(l)
             if (ncidpl.eq.-99) ncidpl=ncidQ  
             endif  
   
 ! Pression de surface  
             if (guide_P) then  
             rcode=nf90_open('ps.nc',nf90_nowrite,ncidps)  
             rcode = nf90_inq_varid(ncidps, 'SP', varidps)  
             print*,'ncidps,varidps',ncidps,varidps  
             endif  
   
 ! Coordonnee 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'  
   
 ! Niveaux de pression  
       print*,'WARNING!!! Il n y a pas de test de coherence'  
       print*,'sur le nombre de niveaux verticaux dans le fichier nc'  
       status=NF_GET_VARA_REAL(ncidpl,varidpl,1,nlevnc,pl)  
 !  passage en pascal  
       pl(:)=100.*pl(:)  
       if (first) then  
        do l=1,nlevnc  
           print*,'PL(',l,')=',pl(l)  
100         enddo         enddo
101        endif      endif
102    
103        !   lecture des champs u, v, T
104    
105        !  dimensions pour les champs scalaires et le vent zonal
106    
107        start(1)=1
108        start(2)=1
109        start(3)=1
110        start(4)=timestep
111    
112        count(1)=iip1
113        count(2)=jjp1
114        count(3)=nlevnc
115        count(4)=1
116    
117        ! mise a zero des tableaux
118    
119        unc(:, :, :)=0.
120        vnc(:, :, :)=0.
121        tnc(:, :, :)=0.
122        Qnc(:, :, :)=0.
123    
124        !  Vent zonal
125    
126        if (guide_u) then
127           print *, 'avant la lecture de UNCEP nd de niv:', nlevnc
128           status=NF90_GET_VAR(ncidu, varidu, unc, start, count)
129           print *, 'WARNING!!! Correction bidon pour palier a un '
130           print *, 'probleme dans la creation des fichiers nc'
131           call correctbid(iim, jjp1*nlevnc, unc)
132           call dump2d(iip1, jjp1, unc, 'UNC COUCHE 1 ')
133        endif
134    
135        !  Temperature
136    
137        print *, 'ncidt=', ncidt, 'varidt=', varidt, 'start=', start
138        print *, 'count=', count
139        if (guide_T) then
140           status=NF90_GET_VAR(ncidt, varidt, tnc, start, count)
141           call dump2d(iip1, jjp1, tnc, 'TNC COUCHE 1 AAA ')
142           call correctbid(iim, jjp1*nlevnc, tnc)
143           call dump2d(iip1, jjp1, tnc, 'TNC COUCHE 1 BBB ')
144        endif
145    
146        !  Humidite
147    
148        if (guide_Q) then
149           status=NF90_GET_VAR(ncidQ, varidQ, Qnc, start, count)
150           call correctbid(iim, jjp1*nlevnc, Qnc)
151           call dump2d(iip1, jjp1, Qnc, 'QNC COUCHE 1 ')
152        endif
153    
154        count(2)=jjm
155        !  Vent meridien
156    
157        if (guide_v) then
158           status=NF90_GET_VAR(ncidv, varidv, vnc, start, count)
159           call correctbid(iim, jjm*nlevnc, vnc)
160           call dump2d(iip1, jjm, vnc, 'VNC COUCHE 1 ')
161        endif
162    
163        start(3)=timestep
164        start(4)=0
165        count(2)=jjp1
166        count(3)=1
167        count(4)=0
168    
169        !  Interpolation verticale sur les niveaux modele
170    
171        call reanalyse2nat(nlevnc, psi, unc, vnc, tnc, Qnc, pl, u, v, t, Q, &
172             masse, pk)
173    
174        call dump2d(iip1, jjm, v, 'V COUCHE APRES ')
175    
176        !  Passage aux variables du modele (vents covariants, temperature
177        !  potentielle et humidite specifique)
178    
179        call nat2gcm(u, v, t, Q, pk, u, v, t, Q)
180        print *, 'TIMESTEP ', timestep
181        first=.false.
182    
183  ! -----------------------------------------------------------------    end subroutine read_reanalyse
 !   lecture des champs u, v, T, ps  
 ! -----------------------------------------------------------------  
   
 !  dimensions pour les champs scalaires et le vent zonal  
 !  -----------------------------------------------------  
   
       start(1)=1  
       start(2)=1  
       start(3)=1  
       start(4)=timestep  
   
       count(1)=iip1  
       count(2)=jjp1  
       count(3)=nlevnc  
       count(4)=1  
   
 ! mise a zero des tableaux  
 ! ------------------------  
        unc(:,:,:)=0.  
        vnc(:,:,:)=0.  
        tnc(:,:,:)=0.  
        Qnc(:,:,:)=0.  
   
 !  Vent zonal  
 !  ----------  
   
       if (guide_u) then  
       print*,'avant la lecture de UNCEP nd de niv:',nlevnc  
       status=NF_GET_VARA_REAL(ncidu,varidu,start,count,unc)  
 !     call dump2d(iip1,jjp1,unc,'VENT NCEP   ')  
 !     call dump2d(iip1,40,unc(1,1,nlevnc),'VENT NCEP   ')  
       print*,'WARNING!!! Correction bidon pour palier a un '  
       print*,'probleme dans la creation des fichiers nc'  
       call correctbid(iim,jjp1*nlevnc,unc)  
       call dump2d(iip1,jjp1,unc,'UNC COUCHE 1 ')  
       endif  
   
 !  Temperature  
 !  -----------  
   
       print*,'ncidt=',ncidt,'varidt=',varidt,'start=',start  
       print*,'count=',count  
       if (guide_T) then  
       status=NF_GET_VARA_REAL(ncidt,varidt,start,count,tnc)  
       call dump2d(iip1,jjp1,tnc,'TNC COUCHE 1 AAA ')  
       call correctbid(iim,jjp1*nlevnc,tnc)  
       call dump2d(iip1,jjp1,tnc,'TNC COUCHE 1 BBB ')  
       endif  
   
 !  Humidite  
 !  --------  
   
       if (guide_Q) then  
       status=NF_GET_VARA_REAL(ncidQ,varidQ,start,count,Qnc)  
       call correctbid(iim,jjp1*nlevnc,Qnc)  
       call dump2d(iip1,jjp1,Qnc,'QNC COUCHE 1 ')  
       endif  
   
       count(2)=jjm  
 !  Vent meridien  
 !  -------------  
   
       if (guide_v) then  
       status=NF_GET_VARA_REAL(ncidv,varidv,start,count,vnc)  
       call correctbid(iim,jjm*nlevnc,vnc)  
       call dump2d(iip1,jjm,vnc,'VNC COUCHE 1 ')  
       endif  
   
       start(3)=timestep  
       start(4)=0  
       count(2)=jjp1  
       count(3)=1  
       count(4)=0  
   
 !  Pression de surface  
 !  -------------------  
   
       if (guide_P) then  
       status=NF_GET_VARA_REAL(ncidps,varidps,start,count,psnc)  
       call dump2d(iip1,jjp1,psnc,'PSNC COUCHE 1 ')  
       call correctbid(iim,jjp1,psnc)  
       endif  
   
   
   
 ! -----------------------------------------------------------------  
 !  Interpollation verticale sur les niveaux modele  
 ! -----------------------------------------------------------------  
       call reanalyse2nat(nlevnc,psi,unc,vnc,tnc,Qnc,psnc,pl,u,v,t,Q &  
           ,ps,masse,pk)  
   
       call dump2d(iip1,jjm,v,'V COUCHE APRES ')  
   
   
 ! -----------------------------------------------------------------  
 !  Passage aux variables du modele (vents covariants, temperature  
 !  potentielle et humidite specifique)  
 ! -----------------------------------------------------------------  
       call nat2gcm(u,v,t,Q,pk,u,v,t,Q)  
       print*,'TIMESTEP ',timestep  
       if(mode.ne.1) stop'mode pas egal 0'  
 !     call dump2d(iip1,jjm,v,'VCOV COUCHE 1 ')  
   
 !   Lignes introduites a une epoque pour un probleme oublie...  
 !     do l=1,llm  
 !        do i=1,iip1  
 !           v(i,1,l)=0.  
 !           v(i,jjm,l)=0.  
 !        enddo  
 !     enddo  
       first=.false.  
184    
185        return  end module read_reanalyse_m
       end  
Legend:
Removed from v.44  
changed lines
  Added in v.88
  ViewVC Help
Powered by ViewVC 1.1.21