/[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 173 by guez, Tue Oct 6 15:57:02 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
12        USE dimens_m, ONLY: iim, jjm, llm
13        use nat2gcm_m, only: nat2gcm
14        USE netcdf, ONLY: nf90_nowrite
15        USE netcdf95, ONLY: nf95_get_var, nf95_inq_dimid, nf95_inq_varid, &
16             nf95_inquire_dimension, nf95_open, find_coord
17        USE paramet_m, ONLY: iip1, jjp1
18        use reanalyse2nat_m, only: reanalyse2nat
19    
20        real, intent(in):: psi(:, :) ! (iip1, jjp1)
21        real, intent(out):: u(:, :, :) ! (iip1, jjp1, llm)
22        real, intent(out):: v(:, :, :) ! (iip1, jjm, llm)
23        real, intent(out):: t(:, :, :), q(:, :, :) ! (iip1, jjp1, llm)
24    
25        ! Local:
26        integer nlevnc
27        integer:: timestep = 0
28        real pk(iip1, jjp1, llm)
29        integer, save:: ncidu, varidu, ncidv, varidv, ncidt, varidt, ncidQ, varidQ
30        integer ncid, varid, dimid
31        real, allocatable, save:: unc(:, :, :) ! (iip1, jjp1, nlevnc)
32        real, allocatable, save:: vnc(:, :, :) ! (iip1, jjm, nlevnc)
33        real, allocatable, save:: tnc(:, :, :), Qnc(:, :, :) ! (iip1, jjp1, nlevnc)
34        real, allocatable, save:: pl(:) ! (nlevnc)
35        real latitude(jjm + 1)
36        logical:: first = .true.
37        logical, save:: invert_y
38    
39        ! -----------------------------------------------------------------
40    
41        ! Initialisation de la lecture des fichiers
42    
43        if (first) then
44           print *, 'Intitialisation de read reanalyse'
45    
46           ! Vent zonal
47           if (guide_u) then
48              call nf95_open('u.nc', nf90_nowrite, ncidu)
49              call nf95_inq_varid(ncidu, 'UWND', varidu)
50           endif
51    
52           ! Vent meridien
53           if (guide_v) then
54              call nf95_open('v.nc', nf90_nowrite, ncidv)
55              call nf95_inq_varid(ncidv, 'VWND', varidv)
56           endif
57    
58           ! Temperature
59           if (guide_T) then
60              call nf95_open('T.nc', nf90_nowrite, ncidt)
61              call nf95_inq_varid(ncidt, 'AIR', varidt)
62           endif
63    
64           ! Humidite
65           if (guide_Q) then
66              call nf95_open('hur.nc', nf90_nowrite, ncidQ)
67              call nf95_inq_varid(ncidQ, 'RH', varidQ)
68           endif
69    
70           ! Coordonn\'ee verticale :
71    
72           if (guide_u) then
73              ncid = ncidu
74           else if (guide_v) then
75              ncid = ncidv
76           else if (guide_T) then
77              ncid = ncidt
78           else
79              ncid = ncidq
80           end if
81    
82           call find_coord(ncid, dimid = dimid, varid = varid, std_name = "plev")
83           call nf95_inquire_dimension(ncid, dimid, nclen = nlevnc)
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    
90           ! Read latitude values just to know their order:
91           call find_coord(ncid, varid = varid, std_name = "latitude")
92           call nf95_get_var(ncid, varid, latitude)
93           invert_y = latitude(1) < latitude(2)
94    
95           first = .false.
96        endif
97    
98        ! lecture des champs u, v, T, q
99    
100        timestep = timestep + 1
101    
102        ! Vent zonal
103        if (guide_u) then
104           call NF95_GET_VAR(ncidu, varidu, unc, start = (/1, 1, 1, timestep/))
105        else
106           unc = 0.
107        end if
108    
109        ! Temperature
110        if (guide_T) then
111           call NF95_GET_VAR(ncidt, varidt, tnc, start = (/1, 1, 1, timestep/))
112        else
113           tnc = 0.
114        end if
115    
116        ! Humidite
117        if (guide_Q) then
118           call NF95_GET_VAR(ncidQ, varidQ, Qnc, start = (/1, 1, 1, timestep/))
119        else
120           Qnc = 0.
121        end if
122    
123        ! Vent meridien
124        if (guide_v) then
125           call NF95_GET_VAR(ncidv, varidv, vnc, start = (/1, 1, 1, timestep/))
126        else
127           vnc = 0.
128        end if
129    
130        call reanalyse2nat(invert_y, psi, unc, vnc, tnc, Qnc, pl, u, v, t, Q, pk)
131        call nat2gcm(pk, u, v, t)
132    
133      end subroutine read_reanalyse
134    
135    end module read_reanalyse_m

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

  ViewVC Help
Powered by ViewVC 1.1.21