/[lmdze]/trunk/libf/dyn3d/Read_reanalyse/read_reanalyse.f90
ViewVC logotype

Diff of /trunk/libf/dyn3d/Read_reanalyse/read_reanalyse.f90

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/libf/dyn3d/read_reanalyse.f revision 20 by guez, Wed Oct 15 16:19:57 2008 UTC trunk/libf/dyn3d/Read_reanalyse/read_reanalyse.f90 revision 61 by guez, Fri Apr 20 14:58:43 2012 UTC
# Line 1  Line 1 
1          subroutine read_reanalyse(timestep,psi &
2             ,u,v,t,q,masse,ps,mode,nlevnc)
3    
4  !  !
5  ! $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 $
6  !  !
7  c  !
8  c  !
9        subroutine read_reanalyse(timestep,psi  !   mode=0 variables naturelles
10       s   ,u,v,t,q,masse,ps,mode,nlevnc)  !   mode=1 variabels GCM
11    
12  c   mode=0 variables naturelles  ! -----------------------------------------------------------------
13  c   mode=1 variabels GCM  !   Declarations
14    ! -----------------------------------------------------------------
 c -----------------------------------------------------------------  
 c   Declarations  
 c -----------------------------------------------------------------  
15        use dimens_m        use dimens_m
16        use paramet_m        use paramet_m
17        use comvert        use comvert
18        use comgeom        use comgeom
19        use guide_m        use conf_guide_m
20        use netcdf        use netcdf
21    
22        IMPLICIT NONE        IMPLICIT NONE
23    
24  c common  ! common
25  c ------  ! ------
26    
27        include "netcdf.inc"  ! arguments
28    ! ---------
   
 c arguments  
 c ---------  
29        integer nlevnc        integer nlevnc
30        integer timestep,mode,l        integer timestep,mode,l
31    
# Line 38  c --------- Line 35  c ---------
35        real masse(iip1,jjp1,llm),pk(iip1,jjp1,llm)        real masse(iip1,jjp1,llm),pk(iip1,jjp1,llm)
36    
37    
38  c local  ! local
39  c -----  ! -----
40        integer ncidu,varidu,ncidv,varidv,ncidt,varidt,ncidps,varidps        integer ncidu,varidu,ncidv,varidv,ncidt,varidt,ncidps,varidps
41        integer ncidpl        integer ncidpl
42        integer varidpl,ncidQ,varidQ        integer varidpl,ncidQ,varidQ
# Line 47  c ----- Line 44  c -----
44        save ncidpl        save ncidpl
45        save varidpl,ncidQ,varidQ        save varidpl,ncidQ,varidQ
46    
47        real*4 unc(iip1,jjp1,nlevnc),vnc(iip1,jjm,nlevnc)        real unc(iip1,jjp1,nlevnc),vnc(iip1,jjm,nlevnc)
48        real*4 tnc(iip1,jjp1,nlevnc),psnc(iip1,jjp1)        real tnc(iip1,jjp1,nlevnc),psnc(iip1,jjp1)
49        real*4 Qnc(iip1,jjp1,nlevnc)        real Qnc(iip1,jjp1,nlevnc)
50        real*4 pl(nlevnc)        real pl(nlevnc)
51    
52        integer start(4),count(4),status        integer start(4),count(4),status
53    
# Line 62  c ----- Line 59  c -----
59    
60    
61    
62  c -----------------------------------------------------------------  ! -----------------------------------------------------------------
63  c   Initialisation de la lecture des fichiers  !   Initialisation de la lecture des fichiers
64  c -----------------------------------------------------------------  ! -----------------------------------------------------------------
65        if (first) then        if (first) then
66             ncidpl=-99             ncidpl=-99
67             print*,'Intitialisation de read reanalsye'             print*,'Intitialisation de read reanalsye'
68    
69  c Vent zonal  ! Vent zonal
70              if (guide_u) then              if (guide_u) then
71              rcode=nf90_open('u.nc',nf90_nowrite,ncidu)              rcode=nf90_open('u.nc',nf90_nowrite,ncidu)
72              rcode = nf90_inq_varid(ncidu, 'UWND', varidu)              rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
# Line 77  c Vent zonal Line 74  c Vent zonal
74              if (ncidpl.eq.-99) ncidpl=ncidu              if (ncidpl.eq.-99) ncidpl=ncidu
75              endif              endif
76    
77  c Vent meridien  ! Vent meridien
78              if (guide_v) then              if (guide_v) then
79              rcode=nf90_open('v.nc',nf90_nowrite,ncidv)              rcode=nf90_open('v.nc',nf90_nowrite,ncidv)
80              rcode = nf90_inq_varid(ncidv, 'VWND', varidv)              rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
# Line 85  c Vent meridien Line 82  c Vent meridien
82              if (ncidpl.eq.-99) ncidpl=ncidv              if (ncidpl.eq.-99) ncidpl=ncidv
83              endif              endif
84    
85  c Temperature  ! Temperature
86              if (guide_T) then              if (guide_T) then
87              rcode=nf90_open('T.nc',nf90_nowrite,ncidt)              rcode=nf90_open('T.nc',nf90_nowrite,ncidt)
88              rcode = nf90_inq_varid(ncidt, 'AIR', varidt)              rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
# Line 93  c Temperature Line 90  c Temperature
90              if (ncidpl.eq.-99) ncidpl=ncidt              if (ncidpl.eq.-99) ncidpl=ncidt
91              endif              endif
92    
93  c Humidite  ! Humidite
94              if (guide_Q) then              if (guide_Q) then
95              rcode=nf90_open('hur.nc',nf90_nowrite,ncidQ)              rcode=nf90_open('hur.nc',nf90_nowrite,ncidQ)
96              rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)              rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
# Line 101  c Humidite Line 98  c Humidite
98              if (ncidpl.eq.-99) ncidpl=ncidQ              if (ncidpl.eq.-99) ncidpl=ncidQ
99              endif              endif
100    
101  c Pression de surface  ! Pression de surface
102              if (guide_P) then              if (guide_P) then
103              rcode=nf90_open('ps.nc',nf90_nowrite,ncidps)              rcode=nf90_open('ps.nc',nf90_nowrite,ncidps)
104              rcode = nf90_inq_varid(ncidps, 'SP', varidps)              rcode = nf90_inq_varid(ncidps, 'SP', varidps)
105              print*,'ncidps,varidps',ncidps,varidps              print*,'ncidps,varidps',ncidps,varidps
106              endif              endif
107    
108  c Coordonnee verticale  ! Coordonnee verticale
109              if (ncep) then              if (ncep) then
110                 print*,'Vous etes entrain de lire des donnees NCEP'                 print*,'Vous etes entrain de lire des donnees NCEP'
111                 rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)                 rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
# Line 120  c Coordonnee verticale Line 117  c Coordonnee verticale
117        endif        endif
118        print*,'ok1'        print*,'ok1'
119    
120  c Niveaux de pression  ! Niveaux de pression
121        print*,'WARNING!!! Il n y a pas de test de coherence'        print*,'WARNING!!! Il n y a pas de test de coherence'
122        print*,'sur le nombre de niveaux verticaux dans le fichier nc'        print*,'sur le nombre de niveaux verticaux dans le fichier nc'
123        status=NF_GET_VARA_REAL(ncidpl,varidpl,1,nlevnc,pl)        status=NF90_GET_VAR(ncidpl,varidpl,pl)
124  c  passage en pascal  !  passage en pascal
125        pl(:)=100.*pl(:)        pl(:)=100.*pl(:)
126        if (first) then        if (first) then
127         do l=1,nlevnc         do l=1,nlevnc
# Line 132  c  passage en pascal Line 129  c  passage en pascal
129         enddo         enddo
130        endif        endif
131    
132  c -----------------------------------------------------------------  ! -----------------------------------------------------------------
133  c   lecture des champs u, v, T, ps  !   lecture des champs u, v, T, ps
134  c -----------------------------------------------------------------  ! -----------------------------------------------------------------
135    
136  c  dimensions pour les champs scalaires et le vent zonal  !  dimensions pour les champs scalaires et le vent zonal
137  c  -----------------------------------------------------  !  -----------------------------------------------------
138    
139        start(1)=1        start(1)=1
140        start(2)=1        start(2)=1
# Line 149  c  ------------------------------------- Line 146  c  -------------------------------------
146        count(3)=nlevnc        count(3)=nlevnc
147        count(4)=1        count(4)=1
148    
149  c mise a zero des tableaux  ! mise a zero des tableaux
150  c ------------------------  ! ------------------------
151         unc(:,:,:)=0.         unc(:,:,:)=0.
152         vnc(:,:,:)=0.         vnc(:,:,:)=0.
153         tnc(:,:,:)=0.         tnc(:,:,:)=0.
154         Qnc(:,:,:)=0.         Qnc(:,:,:)=0.
155    
156  c  Vent zonal  !  Vent zonal
157  c  ----------  !  ----------
158    
159        if (guide_u) then        if (guide_u) then
160        print*,'avant la lecture de UNCEP nd de niv:',nlevnc        print*,'avant la lecture de UNCEP nd de niv:',nlevnc
161        status=NF_GET_VARA_REAL(ncidu,varidu,start,count,unc)        status=NF90_GET_VAR(ncidu,varidu,unc,start,count)
162  c     call dump2d(iip1,jjp1,unc,'VENT NCEP   ')  !     call dump2d(iip1,jjp1,unc,'VENT NCEP   ')
163  c     call dump2d(iip1,40,unc(1,1,nlevnc),'VENT NCEP   ')  !     call dump2d(iip1,40,unc(1,1,nlevnc),'VENT NCEP   ')
164        print*,'WARNING!!! Correction bidon pour palier a un '        print*,'WARNING!!! Correction bidon pour palier a un '
165        print*,'probleme dans la creation des fichiers nc'        print*,'probleme dans la creation des fichiers nc'
166        call correctbid(iim,jjp1*nlevnc,unc)        call correctbid(iim,jjp1*nlevnc,unc)
167        call dump2d(iip1,jjp1,unc,'UNC COUCHE 1 ')        call dump2d(iip1,jjp1,unc,'UNC COUCHE 1 ')
168        endif        endif
169    
170  c  Temperature  !  Temperature
171  c  -----------  !  -----------
172    
173        print*,'ncidt=',ncidt,'varidt=',varidt,'start=',start        print*,'ncidt=',ncidt,'varidt=',varidt,'start=',start
174        print*,'count=',count        print*,'count=',count
175        if (guide_T) then        if (guide_T) then
176        status=NF_GET_VARA_REAL(ncidt,varidt,start,count,tnc)        status=NF90_GET_VAR(ncidt,varidt,tnc,start,count)
177        call dump2d(iip1,jjp1,tnc,'TNC COUCHE 1 AAA ')        call dump2d(iip1,jjp1,tnc,'TNC COUCHE 1 AAA ')
178        call correctbid(iim,jjp1*nlevnc,tnc)        call correctbid(iim,jjp1*nlevnc,tnc)
179        call dump2d(iip1,jjp1,tnc,'TNC COUCHE 1 BBB ')        call dump2d(iip1,jjp1,tnc,'TNC COUCHE 1 BBB ')
180        endif        endif
181    
182  c  Humidite  !  Humidite
183  c  --------  !  --------
184    
185        if (guide_Q) then        if (guide_Q) then
186        status=NF_GET_VARA_REAL(ncidQ,varidQ,start,count,Qnc)        status=NF90_GET_VAR(ncidQ,varidQ,Qnc,start,count)
187        call correctbid(iim,jjp1*nlevnc,Qnc)        call correctbid(iim,jjp1*nlevnc,Qnc)
188        call dump2d(iip1,jjp1,Qnc,'QNC COUCHE 1 ')        call dump2d(iip1,jjp1,Qnc,'QNC COUCHE 1 ')
189        endif        endif
190    
191        count(2)=jjm        count(2)=jjm
192  c  Vent meridien  !  Vent meridien
193  c  -------------  !  -------------
194    
195        if (guide_v) then        if (guide_v) then
196        status=NF_GET_VARA_REAL(ncidv,varidv,start,count,vnc)        status=NF90_GET_VAR(ncidv,varidv,vnc,start,count)
197        call correctbid(iim,jjm*nlevnc,vnc)        call correctbid(iim,jjm*nlevnc,vnc)
198        call dump2d(iip1,jjm,vnc,'VNC COUCHE 1 ')        call dump2d(iip1,jjm,vnc,'VNC COUCHE 1 ')
199        endif        endif
# Line 207  c  ------------- Line 204  c  -------------
204        count(3)=1        count(3)=1
205        count(4)=0        count(4)=0
206    
207  c  Pression de surface  !  Pression de surface
208  c  -------------------  !  -------------------
209    
210        if (guide_P) then        if (guide_P) then
211        status=NF_GET_VARA_REAL(ncidps,varidps,start,count,psnc)        status=NF90_GET_VAR(ncidps,varidps,psnc,start,count)
212        call dump2d(iip1,jjp1,psnc,'PSNC COUCHE 1 ')        call dump2d(iip1,jjp1,psnc,'PSNC COUCHE 1 ')
213        call correctbid(iim,jjp1,psnc)        call correctbid(iim,jjp1,psnc)
214        endif        endif
215    
216    
217    
218  c -----------------------------------------------------------------  ! -----------------------------------------------------------------
219  c  Interpollation verticale sur les niveaux modele  !  Interpollation verticale sur les niveaux modele
220  c -----------------------------------------------------------------  ! -----------------------------------------------------------------
221        call reanalyse2nat(nlevnc,psi,unc,vnc,tnc,Qnc,psnc,pl,u,v,t,Q        call reanalyse2nat(nlevnc,psi,unc,vnc,tnc,Qnc,psnc,pl,u,v,t,Q &
222       s    ,ps,masse,pk)            ,ps,masse,pk)
223    
224        call dump2d(iip1,jjm,v,'V COUCHE APRES ')        call dump2d(iip1,jjm,v,'V COUCHE APRES ')
225    
226    
227  c -----------------------------------------------------------------  ! -----------------------------------------------------------------
228  c  Passage aux variables du modele (vents covariants, temperature  !  Passage aux variables du modele (vents covariants, temperature
229  c  potentielle et humidite specifique)  !  potentielle et humidite specifique)
230  c -----------------------------------------------------------------  ! -----------------------------------------------------------------
231        call nat2gcm(u,v,t,Q,pk,u,v,t,Q)        call nat2gcm(u,v,t,Q,pk,u,v,t,Q)
232        print*,'TIMESTEP ',timestep        print*,'TIMESTEP ',timestep
233        if(mode.ne.1) stop'mode pas egal 0'        if(mode.ne.1) stop'mode pas egal 0'
234  c     call dump2d(iip1,jjm,v,'VCOV COUCHE 1 ')  !     call dump2d(iip1,jjm,v,'VCOV COUCHE 1 ')
235    
236  c   Lignes introduites a une epoque pour un probleme oublie...  !   Lignes introduites a une epoque pour un probleme oublie...
237  c     do l=1,llm  !     do l=1,llm
238  c        do i=1,iip1  !        do i=1,iip1
239  c           v(i,1,l)=0.  !           v(i,1,l)=0.
240  c           v(i,jjm,l)=0.  !           v(i,jjm,l)=0.
241  c        enddo  !        enddo
242  c     enddo  !     enddo
243        first=.false.        first=.false.
244    
245        return        return
246        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.20  
changed lines
  Added in v.61
  ViewVC Help
Powered by ViewVC 1.1.21