/[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 66 by guez, Thu Sep 20 13:00:41 2012 UTC trunk/Sources/dyn3d/Guide/Read_reanalyse/read_reanalyse.f revision 172 by guez, Wed Sep 30 15:59:14 2015 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
 ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/read_reanalyse.F,v 1.3 2005/04/15 12:31:21 lmdzadmin Exp $  
 !  
 !  
 !  
 !   mode=0 variables naturelles  
 !   mode=1 variabels GCM  
   
 ! -----------------------------------------------------------------  
 !   Declarations  
 ! -----------------------------------------------------------------  
       use dimens_m  
       use paramet_m  
       use disvert_m  
       use comgeom  
       use conf_guide_m  
       use netcdf  
   
       IMPLICIT NONE  
   
 ! common  
 ! ------  
   
 ! arguments  
 ! ---------  
       integer nlevnc  
       integer timestep,mode,l  
   
       real psi(iip1,jjp1)  
       real u(iip1,jjp1,llm),v(iip1,jjm,llm)  
       real t(iip1,jjp1,llm),ps(iip1,jjp1),q(iip1,jjp1,llm)  
       real masse(iip1,jjp1,llm),pk(iip1,jjp1,llm)  
   
   
 ! local  
 ! -----  
       integer ncidu,varidu,ncidv,varidv,ncidt,varidt,ncidps,varidps  
       integer ncidpl  
       integer varidpl,ncidQ,varidQ  
       save ncidu,varidu,ncidv,varidv,ncidt,varidt,ncidps,varidps  
       save ncidpl  
       save varidpl,ncidQ,varidQ  
   
       real unc(iip1,jjp1,nlevnc),vnc(iip1,jjm,nlevnc)  
       real tnc(iip1,jjp1,nlevnc),psnc(iip1,jjp1)  
       real Qnc(iip1,jjp1,nlevnc)  
       real pl(nlevnc)  
   
       integer start(4),count(4),status  
   
       real rcode  
       logical first  
       save first  
   
       data first/.true./  
   
   
   
 ! -----------------------------------------------------------------  
 !   Initialisation de la lecture des fichiers  
 ! -----------------------------------------------------------------  
       if (first) then  
            ncidpl=-99  
            print*,'Intitialisation de read reanalsye'  
   
 ! Vent zonal  
             if (guide_u) then  
             rcode=nf90_open('u.nc',nf90_nowrite,ncidu)  
             rcode = nf90_inq_varid(ncidu, 'UWND', varidu)  
             print*,'ncidu,varidu',ncidu,varidu  
             if (ncidpl.eq.-99) ncidpl=ncidu  
             endif  
   
 ! Vent meridien  
             if (guide_v) then  
             rcode=nf90_open('v.nc',nf90_nowrite,ncidv)  
             rcode = nf90_inq_varid(ncidv, 'VWND', varidv)  
             print*,'ncidv,varidv',ncidv,varidv  
             if (ncidpl.eq.-99) ncidpl=ncidv  
             endif  
   
 ! Temperature  
             if (guide_T) then  
             rcode=nf90_open('T.nc',nf90_nowrite,ncidt)  
             rcode = nf90_inq_varid(ncidt, 'AIR', varidt)  
             print*,'ncidt,varidt',ncidt,varidt  
             if (ncidpl.eq.-99) ncidpl=ncidt  
             endif  
   
 ! Humidite  
             if (guide_Q) then  
             rcode=nf90_open('hur.nc',nf90_nowrite,ncidQ)  
             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)  
        enddo  
       endif  
   
 ! -----------------------------------------------------------------  
 !   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.  
4    
5        return  contains
6        end  
7      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
10    
11        USE conf_guide_m, ONLY: guide_q, guide_t, guide_u, guide_v, ncep
12        USE dimens_m, ONLY: iim, jjm, llm
13        USE netcdf, ONLY: nf90_nowrite
14        USE netcdf95, ONLY: nf95_get_var, nf95_inq_dimid, nf95_inq_varid, &
15             nf95_inquire_dimension, nf95_open
16        USE paramet_m, ONLY: iip1, jjp1
17        use reanalyse2nat_m, only: reanalyse2nat
18    
19        real, intent(in):: psi(:, :) ! (iip1, jjp1)
20        real, intent(out):: u(:, :, :) ! (iip1, jjp1, llm)
21        real, intent(out):: v(:, :, :) ! (iip1, jjm, llm)
22        real, intent(out):: t(:, :, :), q(:, :, :) ! (iip1, jjp1, llm)
23    
24        ! Local:
25        integer, save:: nlevnc
26        integer:: timestep = 0
27        real pk(iip1, jjp1, llm)
28        integer, save:: ncidu, varidu, ncidv, varidv, ncidt, varidt, ncidQ, varidQ
29        integer ncid, varid, dimid
30        real, allocatable, save:: unc(:, :, :) ! (iip1, jjp1, nlevnc)
31        real, allocatable, save:: vnc(:, :, :) ! (iip1, jjm, nlevnc)
32        real, allocatable, save:: tnc(:, :, :), Qnc(:, :, :) ! (iip1, jjp1, nlevnc)
33        real, allocatable, save:: pl(:) ! (nlevnc)
34        logical:: first = .true.
35        character(len = 8) name
36    
37        ! -----------------------------------------------------------------
38    
39        ! Initialisation de la lecture des fichiers
40    
41        if (first) then
42           print *, 'Intitialisation de read reanalsye'
43    
44           ! Vent zonal
45           if (guide_u) then
46              call nf95_open('u.nc', nf90_nowrite, ncidu)
47              call nf95_inq_varid(ncidu, 'UWND', varidu)
48           endif
49    
50           ! Vent meridien
51           if (guide_v) then
52              call nf95_open('v.nc', nf90_nowrite, ncidv)
53              call nf95_inq_varid(ncidv, 'VWND', varidv)
54           endif
55    
56           ! Temperature
57           if (guide_T) then
58              call nf95_open('T.nc', nf90_nowrite, ncidt)
59              call nf95_inq_varid(ncidt, 'AIR', varidt)
60           endif
61    
62           ! Humidite
63           if (guide_Q) then
64              call nf95_open('hur.nc', nf90_nowrite, ncidQ)
65              call nf95_inq_varid(ncidQ, 'RH', varidQ)
66           endif
67    
68           ! Coordonn\'ee verticale :
69    
70           if (guide_u) then
71              ncid = ncidu
72           else if (guide_v) then
73              ncid = ncidv
74           else if (guide_T) then
75              ncid = ncidt
76           else
77              ncid = ncidq
78           end if
79    
80           name = merge('LEVEL   ', 'PRESSURE', ncep)
81           call nf95_inq_dimid(ncid, name, dimid)
82           call nf95_inquire_dimension(ncid, dimid, nclen = nlevnc)
83           call nf95_inq_varid(ncid, name, varid)
84           PRINT *, 'nlevnc = ', nlevnc
85           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           first = .false.
90        endif
91    
92        ! lecture des champs u, v, T
93    
94        timestep = timestep + 1
95        unc = 0.
96        vnc = 0.
97        tnc = 0.
98        Qnc = 0.
99    
100        ! Vent zonal
101        if (guide_u) then
102           call NF95_GET_VAR(ncidu, varidu, unc, start = (/1, 1, 1, timestep/))
103           call correctbid(iim, jjp1 * nlevnc, unc)
104        endif
105    
106        ! Temperature
107        if (guide_T) then
108           call NF95_GET_VAR(ncidt, varidt, tnc, start = (/1, 1, 1, timestep/))
109           call correctbid(iim, jjp1 * nlevnc, tnc)
110        endif
111    
112        ! Humidite
113        if (guide_Q) then
114           call NF95_GET_VAR(ncidQ, varidQ, Qnc, start = (/1, 1, 1, timestep/))
115           call correctbid(iim, jjp1 * nlevnc, Qnc)
116        endif
117    
118        ! Vent meridien
119        if (guide_v) then
120           call NF95_GET_VAR(ncidv, varidv, vnc, start = (/1, 1, 1, timestep/))
121           call correctbid(iim, jjm * nlevnc, vnc)
122        endif
123    
124        call reanalyse2nat(nlevnc, psi, unc, vnc, tnc, Qnc, pl, u, v, t, Q, pk)
125        call nat2gcm(u, v, t, Q, pk, u, v, t, Q)
126    
127      end subroutine read_reanalyse
128    
129    end module read_reanalyse_m

Legend:
Removed from v.66  
changed lines
  Added in v.172

  ViewVC Help
Powered by ViewVC 1.1.21