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

Diff of /trunk/dyn3d/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 61 by guez, Fri Apr 20 14:58:43 2012 UTC trunk/dyn3d/Read_reanalyse/read_reanalyse.f revision 108 by guez, Tue Sep 16 14:00:41 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  ! arguments      integer l
27  ! ---------      real pk(iip1, jjp1, llm)
28        integer nlevnc      integer, save:: ncidu, varidu, ncidv, varidv, ncidt, varidt
29        integer timestep,mode,l      integer, save:: ncidpl
30        integer, save:: varidpl, ncidQ, varidQ
31        real psi(iip1,jjp1)      real unc(iip1, jjp1, nlevnc), vnc(iip1, jjm, nlevnc)
32        real u(iip1,jjp1,llm),v(iip1,jjm,llm)      real tnc(iip1, jjp1, nlevnc)
33        real t(iip1,jjp1,llm),ps(iip1,jjp1),q(iip1,jjp1,llm)      real Qnc(iip1, jjp1, nlevnc)
34        real masse(iip1,jjp1,llm),pk(iip1,jjp1,llm)      real pl(nlevnc)
35        integer start(4), count(4), status
36        real rcode
37  ! local      logical:: first = .true.
38  ! -----  
39        integer ncidu,varidu,ncidv,varidv,ncidt,varidt,ncidps,varidps      ! -----------------------------------------------------------------
40        integer ncidpl  
41        integer varidpl,ncidQ,varidQ      !   Initialisation de la lecture des fichiers
42        save ncidu,varidu,ncidv,varidv,ncidt,varidt,ncidps,varidps  
43        save ncidpl      if (first) then
44        save varidpl,ncidQ,varidQ         ncidpl=-99
45           print *, 'Intitialisation de read reanalsye'
46        real unc(iip1,jjp1,nlevnc),vnc(iip1,jjm,nlevnc)  
47        real tnc(iip1,jjp1,nlevnc),psnc(iip1,jjp1)         ! Vent zonal
48        real Qnc(iip1,jjp1,nlevnc)         if (guide_u) then
49        real pl(nlevnc)            rcode=nf90_open('u.nc', nf90_nowrite, ncidu)
50              rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
51        integer start(4),count(4),status            if (ncidpl.eq.-99) ncidpl=ncidu
52           endif
53        real rcode  
54        logical first         ! Vent meridien
55        save first         if (guide_v) then
56              rcode=nf90_open('v.nc', nf90_nowrite, ncidv)
57        data first/.true./            rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
58              if (ncidpl.eq.-99) ncidpl=ncidv
59           endif
60    
61  ! -----------------------------------------------------------------         ! Temperature
62  !   Initialisation de la lecture des fichiers         if (guide_T) then
63  ! -----------------------------------------------------------------            rcode=nf90_open('T.nc', nf90_nowrite, ncidt)
64        if (first) then            rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
65             ncidpl=-99            if (ncidpl.eq.-99) ncidpl=ncidt
66             print*,'Intitialisation de read reanalsye'         endif
67    
68  ! Vent zonal         ! Humidite
69              if (guide_u) then         if (guide_Q) then
70              rcode=nf90_open('u.nc',nf90_nowrite,ncidu)            rcode=nf90_open('hur.nc', nf90_nowrite, ncidQ)
71              rcode = nf90_inq_varid(ncidu, 'UWND', varidu)            rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
72              print*,'ncidu,varidu',ncidu,varidu            if (ncidpl.eq.-99) ncidpl=ncidQ
73              if (ncidpl.eq.-99) ncidpl=ncidu         endif
74              endif  
75           ! Coordonnee verticale
76  ! Vent meridien         if (ncep) then
77              if (guide_v) then            print *, 'Vous etes entrain de lire des donnees NCEP'
78              rcode=nf90_open('v.nc',nf90_nowrite,ncidv)            rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
79              rcode = nf90_inq_varid(ncidv, 'VWND', varidv)         else
80              print*,'ncidv,varidv',ncidv,varidv            print *, 'Vous etes entrain de lire des donnees ECMWF'
81              if (ncidpl.eq.-99) ncidpl=ncidv            rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
82              endif         endif
83        endif
84  ! Temperature  
85              if (guide_T) then      ! Niveaux de pression
86              rcode=nf90_open('T.nc',nf90_nowrite,ncidt)  
87              rcode = nf90_inq_varid(ncidt, 'AIR', varidt)      ! Warning: il n y a pas de test de coherence sur le nombre de
88              print*,'ncidt,varidt',ncidt,varidt      ! niveaux verticaux dans le fichier nc'
89              if (ncidpl.eq.-99) ncidpl=ncidt      status=NF90_GET_VAR(ncidpl, varidpl, pl)
90              endif      !  passage en pascal
91        pl(:)=100.*pl(:)
92  ! Humidite      if (first) then
93              if (guide_Q) then         do l=1, nlevnc
94              rcode=nf90_open('hur.nc',nf90_nowrite,ncidQ)            print *, 'PL(', l, ')=', pl(l)
             rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)  
             print*,'ncidQ,varidQ',ncidQ,varidQ  
             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=NF90_GET_VAR(ncidpl,varidpl,pl)  
 !  passage en pascal  
       pl(:)=100.*pl(:)  
       if (first) then  
        do l=1,nlevnc  
           print*,'PL(',l,')=',pl(l)  
95         enddo         enddo
96        endif      endif
97    
98        !   lecture des champs u, v, T
99    
100        !  dimensions pour les champs scalaires et le vent zonal
101    
102        start(1)=1
103        start(2)=1
104        start(3)=1
105        start(4)=timestep
106    
107        count(1)=iip1
108        count(2)=jjp1
109        count(3)=nlevnc
110        count(4)=1
111    
112        ! mise a zero des tableaux
113    
114        unc(:, :, :)=0.
115        vnc(:, :, :)=0.
116        tnc(:, :, :)=0.
117        Qnc(:, :, :)=0.
118    
119        !  Vent zonal
120    
121        if (guide_u) then
122           status=NF90_GET_VAR(ncidu, varidu, unc, start, count)
123           ! Warning Correction bidon pour palier a un probleme dans la
124           ! creation des fichiers nc
125           call correctbid(iim, jjp1*nlevnc, unc)
126        endif
127    
128        !  Temperature
129    
130        if (guide_T) then
131           status=NF90_GET_VAR(ncidt, varidt, tnc, start, count)
132           call correctbid(iim, jjp1*nlevnc, tnc)
133        endif
134    
135        !  Humidite
136    
137        if (guide_Q) then
138           status=NF90_GET_VAR(ncidQ, varidQ, Qnc, start, count)
139           call correctbid(iim, jjp1*nlevnc, Qnc)
140        endif
141    
142        count(2)=jjm
143        !  Vent meridien
144    
145        if (guide_v) then
146           status=NF90_GET_VAR(ncidv, varidv, vnc, start, count)
147           call correctbid(iim, jjm*nlevnc, vnc)
148        endif
149    
150        start(3)=timestep
151        start(4)=0
152        count(2)=jjp1
153        count(3)=1
154        count(4)=0
155    
156        !  Interpolation verticale sur les niveaux modele
157    
158        call reanalyse2nat(nlevnc, psi, unc, vnc, tnc, Qnc, pl, u, v, t, Q, &
159             masse, pk)
160    
161        !  Passage aux variables du modele (vents covariants, temperature
162        !  potentielle et humidite specifique)
163    
164        call nat2gcm(u, v, t, Q, pk, u, v, t, Q)
165        first=.false.
166    
167  ! -----------------------------------------------------------------    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=NF90_GET_VAR(ncidu,varidu,unc,start,count)  
 !     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=NF90_GET_VAR(ncidt,varidt,tnc,start,count)  
       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=NF90_GET_VAR(ncidQ,varidQ,Qnc,start,count)  
       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=NF90_GET_VAR(ncidv,varidv,vnc,start,count)  
       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=NF90_GET_VAR(ncidps,varidps,psnc,start,count)  
       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.  
168    
169        return  end module read_reanalyse_m
       end  

Legend:
Removed from v.61  
changed lines
  Added in v.108

  ViewVC Help
Powered by ViewVC 1.1.21