/[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.f revision 3 by guez, Wed Feb 27 13:16:39 2008 UTC trunk/dyn3d/Read_reanalyse/read_reanalyse.f revision 85 by guez, Thu Mar 6 17:35:22 2014 UTC
# Line 1  Line 1 
1          subroutine read_reanalyse(timestep,psi,u,v,t,q,masse,mode,nlevnc)
2    
3  !  !
4  ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/read_reanalyse.F,v 1.3 2005/04/15 12:31:21 lmdzadmin Exp $  ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/read_reanalyse.F,v 1.3 2005/04/15 12:31:21 lmdzadmin Exp $
5  !  !
6  c  !
7  c  !
8        subroutine read_reanalyse(timestep,psi  !   mode=0 variables naturelles
9       s   ,u,v,t,q,masse,ps,mode,nlevnc)  !   mode=1 variabels GCM
10    
11  c   mode=0 variables naturelles  ! -----------------------------------------------------------------
12  c   mode=1 variabels GCM  !   Declarations
13    ! -----------------------------------------------------------------
 c -----------------------------------------------------------------  
 c   Declarations  
 c -----------------------------------------------------------------  
14        use dimens_m        use dimens_m
15        use paramet_m        use paramet_m
16        use comvert        use disvert_m
17        use comgeom        use comgeom
18        use guide_m        use conf_guide_m
19        IMPLICIT NONE        use netcdf
   
 c common  
 c ------  
20    
21        include "netcdf.inc"        IMPLICIT NONE
22    
23    ! common
24    ! ------
25    
26  c arguments  ! arguments
27  c ---------  ! ---------
28        integer nlevnc        integer nlevnc
29        integer timestep,mode,l        integer timestep,mode,l
30    
31        real psi(iip1,jjp1)        real, intent(in):: psi(iip1,jjp1)
32        real u(iip1,jjp1,llm),v(iip1,jjm,llm)        real u(iip1,jjp1,llm),v(iip1,jjm,llm)
33        real t(iip1,jjp1,llm),ps(iip1,jjp1),q(iip1,jjp1,llm)        real t(iip1,jjp1,llm),q(iip1,jjp1,llm)
34        real masse(iip1,jjp1,llm),pk(iip1,jjp1,llm)        real masse(iip1,jjp1,llm),pk(iip1,jjp1,llm)
35    
36    
37  c local  ! local
38  c -----  ! -----
39        integer ncidu,varidu,ncidv,varidv,ncidt,varidt,ncidps,varidps        integer ncidu,varidu,ncidv,varidv,ncidt,varidt,ncidps,varidps
40        integer ncidpl        integer ncidpl
41        integer varidpl,ncidQ,varidQ        integer varidpl,ncidQ,varidQ
# Line 45  c ----- Line 43  c -----
43        save ncidpl        save ncidpl
44        save varidpl,ncidQ,varidQ        save varidpl,ncidQ,varidQ
45    
46        real*4 unc(iip1,jjp1,nlevnc),vnc(iip1,jjm,nlevnc)        real unc(iip1,jjp1,nlevnc),vnc(iip1,jjm,nlevnc)
47        real*4 tnc(iip1,jjp1,nlevnc),psnc(iip1,jjp1)        real tnc(iip1,jjp1,nlevnc),psnc(iip1,jjp1)
48        real*4 Qnc(iip1,jjp1,nlevnc)        real Qnc(iip1,jjp1,nlevnc)
49        real*4 pl(nlevnc)        real pl(nlevnc)
50    
51        integer start(4),count(4),status        integer start(4),count(4),status
52    
# Line 60  c ----- Line 58  c -----
58    
59    
60    
61  c -----------------------------------------------------------------  ! -----------------------------------------------------------------
62  c   Initialisation de la lecture des fichiers  !   Initialisation de la lecture des fichiers
63  c -----------------------------------------------------------------  ! -----------------------------------------------------------------
64        if (first) then        if (first) then
65             ncidpl=-99             ncidpl=-99
66             print*,'Intitialisation de read reanalsye'             print*,'Intitialisation de read reanalsye'
67    
68  c Vent zonal  ! Vent zonal
69              if (guide_u) then              if (guide_u) then
70              ncidu=NCOPN('u.nc',NCNOWRIT,rcode)              rcode=nf90_open('u.nc',nf90_nowrite,ncidu)
71              varidu=NCVID(ncidu,'UWND',rcode)              rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
72              print*,'ncidu,varidu',ncidu,varidu              print*,'ncidu,varidu',ncidu,varidu
73              if (ncidpl.eq.-99) ncidpl=ncidu              if (ncidpl.eq.-99) ncidpl=ncidu
74              endif              endif
75    
76  c Vent meridien  ! Vent meridien
77              if (guide_v) then              if (guide_v) then
78              ncidv=NCOPN('v.nc',NCNOWRIT,rcode)              rcode=nf90_open('v.nc',nf90_nowrite,ncidv)
79              varidv=NCVID(ncidv,'VWND',rcode)              rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
80              print*,'ncidv,varidv',ncidv,varidv              print*,'ncidv,varidv',ncidv,varidv
81              if (ncidpl.eq.-99) ncidpl=ncidv              if (ncidpl.eq.-99) ncidpl=ncidv
82              endif              endif
83    
84  c Temperature  ! Temperature
85              if (guide_T) then              if (guide_T) then
86              ncidt=NCOPN('T.nc',NCNOWRIT,rcode)              rcode=nf90_open('T.nc',nf90_nowrite,ncidt)
87              varidt=NCVID(ncidt,'AIR',rcode)              rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
88              print*,'ncidt,varidt',ncidt,varidt              print*,'ncidt,varidt',ncidt,varidt
89              if (ncidpl.eq.-99) ncidpl=ncidt              if (ncidpl.eq.-99) ncidpl=ncidt
90              endif              endif
91    
92  c Humidite  ! Humidite
93              if (guide_Q) then              if (guide_Q) then
94              ncidQ=NCOPN('hur.nc',NCNOWRIT,rcode)              rcode=nf90_open('hur.nc',nf90_nowrite,ncidQ)
95              varidQ=NCVID(ncidQ,'RH',rcode)              rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
96              print*,'ncidQ,varidQ',ncidQ,varidQ              print*,'ncidQ,varidQ',ncidQ,varidQ
97              if (ncidpl.eq.-99) ncidpl=ncidQ              if (ncidpl.eq.-99) ncidpl=ncidQ
98              endif              endif
99    
100  c Pression de surface  ! Coordonnee verticale
             if (guide_P) then  
             ncidps=NCOPN('ps.nc',NCNOWRIT,rcode)  
             varidps=NCVID(ncidps,'SP',rcode)  
             print*,'ncidps,varidps',ncidps,varidps  
             endif  
   
 c Coordonnee verticale  
101              if (ncep) then              if (ncep) then
102                 print*,'Vous etes entrain de lire des donnees NCEP'                 print*,'Vous etes entrain de lire des donnees NCEP'
103                 varidpl=NCVID(ncidpl,'LEVEL',rcode)                 rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
104              else              else
105                 print*,'Vous etes entrain de lire des donnees ECMWF'                 print*,'Vous etes entrain de lire des donnees ECMWF'
106                 varidpl=NCVID(ncidpl,'PRESSURE',rcode)                 rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
107              endif              endif
108              print*,'ncidu,varidpl',ncidu,varidpl              print*,'ncidu,varidpl',ncidu,varidpl
109        endif        endif
110        print*,'ok1'        print*,'ok1'
111    
112  c Niveaux de pression  ! Niveaux de pression
113        print*,'WARNING!!! Il n y a pas de test de coherence'        print*,'WARNING!!! Il n y a pas de test de coherence'
114        print*,'sur le nombre de niveaux verticaux dans le fichier nc'        print*,'sur le nombre de niveaux verticaux dans le fichier nc'
115        status=NF_GET_VARA_REAL(ncidpl,varidpl,1,nlevnc,pl)        status=NF90_GET_VAR(ncidpl,varidpl,pl)
116  c  passage en pascal  !  passage en pascal
117        pl(:)=100.*pl(:)        pl(:)=100.*pl(:)
118        if (first) then        if (first) then
119         do l=1,nlevnc         do l=1,nlevnc
# Line 130  c  passage en pascal Line 121  c  passage en pascal
121         enddo         enddo
122        endif        endif
123    
124  c -----------------------------------------------------------------  ! -----------------------------------------------------------------
125  c   lecture des champs u, v, T, ps  !   lecture des champs u, v, T
126  c -----------------------------------------------------------------  ! -----------------------------------------------------------------
127    
128  c  dimensions pour les champs scalaires et le vent zonal  !  dimensions pour les champs scalaires et le vent zonal
129  c  -----------------------------------------------------  !  -----------------------------------------------------
130    
131        start(1)=1        start(1)=1
132        start(2)=1        start(2)=1
# Line 147  c  ------------------------------------- Line 138  c  -------------------------------------
138        count(3)=nlevnc        count(3)=nlevnc
139        count(4)=1        count(4)=1
140    
141  c mise a zero des tableaux  ! mise a zero des tableaux
142  c ------------------------  ! ------------------------
143         unc(:,:,:)=0.         unc(:,:,:)=0.
144         vnc(:,:,:)=0.         vnc(:,:,:)=0.
145         tnc(:,:,:)=0.         tnc(:,:,:)=0.
146         Qnc(:,:,:)=0.         Qnc(:,:,:)=0.
147    
148  c  Vent zonal  !  Vent zonal
149  c  ----------  !  ----------
150    
151        if (guide_u) then        if (guide_u) then
152        print*,'avant la lecture de UNCEP nd de niv:',nlevnc        print*,'avant la lecture de UNCEP nd de niv:',nlevnc
153        status=NF_GET_VARA_REAL(ncidu,varidu,start,count,unc)        status=NF90_GET_VAR(ncidu,varidu,unc,start,count)
154  c     call dump2d(iip1,jjp1,unc,'VENT NCEP   ')  !     call dump2d(iip1,jjp1,unc,'VENT NCEP   ')
155  c     call dump2d(iip1,40,unc(1,1,nlevnc),'VENT NCEP   ')  !     call dump2d(iip1,40,unc(1,1,nlevnc),'VENT NCEP   ')
156        print*,'WARNING!!! Correction bidon pour palier a un '        print*,'WARNING!!! Correction bidon pour palier a un '
157        print*,'probleme dans la creation des fichiers nc'        print*,'probleme dans la creation des fichiers nc'
158        call correctbid(iim,jjp1*nlevnc,unc)        call correctbid(iim,jjp1*nlevnc,unc)
159        call dump2d(iip1,jjp1,unc,'UNC COUCHE 1 ')        call dump2d(iip1,jjp1,unc,'UNC COUCHE 1 ')
160        endif        endif
161    
162  c  Temperature  !  Temperature
163  c  -----------  !  -----------
164    
165        print*,'ncidt=',ncidt,'varidt=',varidt,'start=',start        print*,'ncidt=',ncidt,'varidt=',varidt,'start=',start
166        print*,'count=',count        print*,'count=',count
167        if (guide_T) then        if (guide_T) then
168        status=NF_GET_VARA_REAL(ncidt,varidt,start,count,tnc)        status=NF90_GET_VAR(ncidt,varidt,tnc,start,count)
169        call dump2d(iip1,jjp1,tnc,'TNC COUCHE 1 AAA ')        call dump2d(iip1,jjp1,tnc,'TNC COUCHE 1 AAA ')
170        call correctbid(iim,jjp1*nlevnc,tnc)        call correctbid(iim,jjp1*nlevnc,tnc)
171        call dump2d(iip1,jjp1,tnc,'TNC COUCHE 1 BBB ')        call dump2d(iip1,jjp1,tnc,'TNC COUCHE 1 BBB ')
172        endif        endif
173    
174  c  Humidite  !  Humidite
175  c  --------  !  --------
176    
177        if (guide_Q) then        if (guide_Q) then
178        status=NF_GET_VARA_REAL(ncidQ,varidQ,start,count,Qnc)        status=NF90_GET_VAR(ncidQ,varidQ,Qnc,start,count)
179        call correctbid(iim,jjp1*nlevnc,Qnc)        call correctbid(iim,jjp1*nlevnc,Qnc)
180        call dump2d(iip1,jjp1,Qnc,'QNC COUCHE 1 ')        call dump2d(iip1,jjp1,Qnc,'QNC COUCHE 1 ')
181        endif        endif
182    
183        count(2)=jjm        count(2)=jjm
184  c  Vent meridien  !  Vent meridien
185  c  -------------  !  -------------
186    
187        if (guide_v) then        if (guide_v) then
188        status=NF_GET_VARA_REAL(ncidv,varidv,start,count,vnc)        status=NF90_GET_VAR(ncidv,varidv,vnc,start,count)
189        call correctbid(iim,jjm*nlevnc,vnc)        call correctbid(iim,jjm*nlevnc,vnc)
190        call dump2d(iip1,jjm,vnc,'VNC COUCHE 1 ')        call dump2d(iip1,jjm,vnc,'VNC COUCHE 1 ')
191        endif        endif
# Line 205  c  ------------- Line 196  c  -------------
196        count(3)=1        count(3)=1
197        count(4)=0        count(4)=0
198    
199  c  Pression de surface  !  Interpollation verticale sur les niveaux modele
200  c  -------------------  ! -----------------------------------------------------------------
201          call reanalyse2nat(nlevnc,psi,unc,vnc,tnc,Qnc,psnc,pl,u,v,t,Q,masse,pk)
       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  
   
   
   
 c -----------------------------------------------------------------  
 c  Interpollation verticale sur les niveaux modele  
 c -----------------------------------------------------------------  
       call reanalyse2nat(nlevnc,psi,unc,vnc,tnc,Qnc,psnc,pl,u,v,t,Q  
      s    ,ps,masse,pk)  
202    
203        call dump2d(iip1,jjm,v,'V COUCHE APRES ')        call dump2d(iip1,jjm,v,'V COUCHE APRES ')
204    
205    
206  c -----------------------------------------------------------------  ! -----------------------------------------------------------------
207  c  Passage aux variables du modele (vents covariants, temperature  !  Passage aux variables du modele (vents covariants, temperature
208  c  potentielle et humidite specifique)  !  potentielle et humidite specifique)
209  c -----------------------------------------------------------------  ! -----------------------------------------------------------------
210        call nat2gcm(u,v,t,Q,pk,u,v,t,Q)        call nat2gcm(u,v,t,Q,pk,u,v,t,Q)
211        print*,'TIMESTEP ',timestep        print*,'TIMESTEP ',timestep
212        if(mode.ne.1) stop'mode pas egal 0'        if(mode.ne.1) stop'mode pas egal 0'
213  c     call dump2d(iip1,jjm,v,'VCOV COUCHE 1 ')  !     call dump2d(iip1,jjm,v,'VCOV COUCHE 1 ')
214    
215  c   Lignes introduites a une epoque pour un probleme oublie...  !   Lignes introduites a une epoque pour un probleme oublie...
216  c     do l=1,llm  !     do l=1,llm
217  c        do i=1,iip1  !        do i=1,iip1
218  c           v(i,1,l)=0.  !           v(i,1,l)=0.
219  c           v(i,jjm,l)=0.  !           v(i,jjm,l)=0.
220  c        enddo  !        enddo
221  c     enddo  !     enddo
222        first=.false.        first=.false.
223    
224        return        return
225        end        end
   
   
 c===========================================================================  
       subroutine reanalyse2nat(nlevnc,psi  
      s   ,unc,vnc,tnc,qnc,psnc,pl,u,v,t,q  
      s   ,ps,masse,pk)  
 c===========================================================================  
   
 c -----------------------------------------------------------------  
 c   Inversion Nord/sud de la grille + interpollation sur les niveaux  
 c   verticaux du modele.  
 c -----------------------------------------------------------------  
   
       use dimens_m  
       use paramet_m  
       use comconst  
       use comvert  
       use comgeom  
       use exner_hyb_m, only: exner_hyb  
       use guide_m  
       use pression_m, only: pression  
   
       implicit none  
   
   
       integer nlevnc  
       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 pl(nlevnc)  
       real unc(iip1,jjp1,nlevnc),vnc(iip1,jjm,nlevnc)  
       real tnc(iip1,jjp1,nlevnc),psnc(iip1,jjp1)  
       real qnc(iip1,jjp1,nlevnc)  
   
       real zu(iip1,jjp1,llm),zv(iip1,jjm,llm)  
       real zt(iip1,jjp1,llm),zq(iip1,jjp1,llm)  
   
       real pext(iip1,jjp1,llm)  
       real pbarx(iip1,jjp1,llm),pbary(iip1,jjm,llm)  
       real plunc(iip1,jjp1,llm),plvnc(iip1,jjm,llm)  
       real plsnc(iip1,jjp1,llm)  
   
       real p(iip1,jjp1,llmp1),pk(iip1,jjp1,llm),pks(iip1,jjp1)  
       real pkf(iip1,jjp1,llm)  
       real masse(iip1,jjp1,llm),pls(iip1,jjp1,llm)  
       real prefkap,unskap  
   
   
       integer i,j,l  
   
   
 c -----------------------------------------------------------------  
 c   calcul de la pression au milieu des couches.  
 c -----------------------------------------------------------------  
   
       CALL pression( ip1jmp1, ap, bp, psi, p )  
       call massdair(p,masse)  
       CALL exner_hyb(psi,p,pks,pk,pkf)  
   
 c    ....  Calcul de pls , pression au milieu des couches ,en Pascals  
       unskap=1./kappa  
       prefkap =  preff  ** kappa  
 c     PRINT *,' Pref kappa unskap  ',preff,kappa,unskap  
       DO l = 1, llm  
        DO j=1,jjp1  
         DO i =1, iip1  
         pls(i,j,l) = preff * ( pk(i,j,l)/cpp) ** unskap  
         ENDDO  
        ENDDO  
        ENDDO  
   
   
 c -----------------------------------------------------------------  
 c   calcul des pressions pour les grilles u et v  
 c -----------------------------------------------------------------  
   
       do l=1,llm  
       do j=1,jjp1  
          do i=1,iip1  
             pext(i,j,l)=pls(i,j,l)*aire_2d(i,j)  
          enddo  
       enddo  
       enddo  
       call massbar(pext, pbarx, pbary )  
       do l=1,llm  
       do j=1,jjp1  
          do i=1,iip1  
             plunc(i,jjp1+1-j,l)=pbarx(i,j,l)/aireu_2d(i,j)  
             plsnc(i,jjp1+1-j,l)=pls(i,j,l)  
          enddo  
       enddo  
       enddo  
       do l=1,llm  
       do j=1,jjm  
          do i=1,iip1  
             plvnc(i,jjm+1-j,l)=pbary(i,j,l)/airev_2d(i,j)  
          enddo  
       enddo  
       enddo  
   
 c -----------------------------------------------------------------  
   
       if (guide_P) then  
       do j=1,jjp1  
          do i=1,iim  
             ps(i,j)=psnc(i,jjp1+1-j)  
          enddo  
          ps(iip1,j)=ps(1,j)  
       enddo  
       endif  
   
   
 c -----------------------------------------------------------------  
       call pres2lev(unc,zu,nlevnc,llm,pl,plunc,iip1,jjp1)  
       call pres2lev(vnc,zv,nlevnc,llm,pl,plvnc,iip1,jjm )  
       call pres2lev(tnc,zt,nlevnc,llm,pl,plsnc,iip1,jjp1)  
       call pres2lev(qnc,zq,nlevnc,llm,pl,plsnc,iip1,jjp1)  
   
 c     call dump2d(iip1,jjp1,ps,'PS    ')  
 c     call dump2d(iip1,jjp1,psu,'PS    ')  
 c     call dump2d(iip1,jjm,psv,'PS    ')  
 c  Inversion Nord/Sud  
       do l=1,llm  
          do j=1,jjp1  
             do i=1,iim  
                u(i,j,l)=zu(i,jjp1+1-j,l)  
                t(i,j,l)=zt(i,jjp1+1-j,l)  
                q(i,j,l)=zq(i,jjp1+1-j,l)  
             enddo  
             u(iip1,j,l)=u(1,j,l)  
             t(iip1,j,l)=t(1,j,l)  
             q(iip1,j,l)=q(1,j,l)  
          enddo  
       enddo  
   
       do l=1,llm  
          do j=1,jjm  
             do i=1,iim  
                v(i,j,l)=zv(i,jjm+1-j,l)  
             enddo  
             v(iip1,j,l)=v(1,j,l)  
          enddo  
       enddo  
   
       return  
       end  
   
 c===========================================================================  
       subroutine nat2gcm(u,v,t,rh,pk,ucov,vcov,teta,q)  
 c===========================================================================  
   
       use dimens_m  
       use paramet_m  
       use comconst  
       use comvert  
       use comgeom  
       use q_sat_m, only: q_sat  
       use guide_m  
       implicit none  
   
   
       real u(iip1,jjp1,llm),v(iip1,jjm,llm)  
       real t(iip1,jjp1,llm),pk(iip1,jjp1,llm),rh(iip1,jjp1,llm)  
       real ps(iip1,jjp1)  
   
       real ucov(iip1,jjp1,llm),vcov(iip1,jjm,llm)  
       real teta(iip1,jjp1,llm),q(iip1,jjp1,llm)  
   
       real pres(iip1,jjp1,llm),qsat(iip1,jjp1,llm)  
   
       real unskap  
   
       integer i,j,l  
   
   
       print*,'Entree dans nat2gcm'  
 c    ucov(:,:,:)=0.  
 c    do l=1,llm  
 c       ucov(:,2:jjm,l)=u(:,2:jjm,l)*cu_2d(:,2:jjm)  
 c    enddo  
 c    ucov(iip1,:,:)=ucov(1,:,:)  
   
 c    teta(:,:,:)=t(:,:,:)*cpp/pk(:,:,:)  
 c    teta(iip1,:,:)=teta(1,:,:)  
       
 c   calcul de ucov et de la temperature potentielle  
       do l=1,llm  
          do j=1,jjp1  
             do i=1,iim  
                ucov(i,j,l)=u(i,j,l)*cu_2d(i,j)  
                teta(i,j,l)=t(i,j,l)*cpp/pk(i,j,l)  
             enddo  
             ucov(iip1,j,l)=ucov(1,j,l)  
             teta(iip1,j,l)=teta(1,j,l)  
          enddo  
          do i=1,iip1  
             ucov(i,1,l)=0.  
             ucov(i,jjp1,l)=0.  
             teta(i,1,l)=teta(1,1,l)  
             teta(i,jjp1,l)=teta(1,jjp1,l)  
          enddo  
       enddo  
   
 c   calcul de ucov  
       do l=1,llm  
          do j=1,jjm  
             do i=1,iim  
                vcov(i,j,l)=v(i,j,l)*cv_2d(i,j)  
             enddo  
             vcov(iip1,j,l)=vcov(1,j,l)  
          enddo  
       enddo  
   
 c     call dump2d(iip1,jjp1,teta,'TETA EN BAS   ')  
 c     call dump2d(iip1,jjp1,teta(1,1,llm),'TETA EN HAUT   ')  
   
 c  Humidite relative -> specifique  
 c  -------------------------------  
       if (1.eq.0) then  
 c   FINALEMENT ON GUIDE EN HUMIDITE RELATIVE  
       print*,'calcul de unskap'  
       unskap   = 1./ kappa  
       print*,'calcul de pres'  
       pres(:,:,:)=preff*(pk(:,:,:)/cpp)**unskap  
       print*,'calcul de qsat'  
       qsat = q_sat(t, pres)  
       print*,'calcul de q'  
 c   ATTENTION : humidites relatives en %  
       rh(:,:,:)=max(rh(:,:,:)*0.01,1.e-6)  
       q(:,:,:)=qsat(:,:,:)*rh(:,:,:)  
       print*,'calcul de q OK'  
   
       call dump2d(iip1,jjp1,pres,'PRESSION PREMIERE COUCHE   ')  
       call dump2d(iip1,jjp1,q,'HUMIDITE SPECIFIQUE COUCHE 1   ')  
       endif  
   
   
       return  
       end  
   
   
   
 c===========================================================================  
       subroutine correctbid(iim,nl,x)  
 c===========================================================================  
       integer iim,nl  
       real x(iim+1,nl)  
       integer i,l  
       real zz  
   
       do l=1,nl  
          do i=2,iim-1  
             if(abs(x(i,l)).gt.1.e10) then  
                zz=0.5*(x(i-1,l)+x(i+1,l))  
 c              print*,'correction ',i,l,x(i,l),zz  
                x(i,l)=zz  
             endif  
          enddo  
       enddo  
       return  
       end  
Legend:
Removed from v.3  
changed lines
  Added in v.85
  ViewVC Help
Powered by ViewVC 1.1.21