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