source: LMDZ.3.3/branches/rel-LF/libf/dyn3d/redecoupenc.F @ 4327

Last change on this file since 4327 was 232, checked in by lmdzadmin, 23 years ago

Merge par rapport a la branche principale
LF

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 35.5 KB
Line 
1c
2c $Header$
3c
4      SUBROUTINE redecoupenc
5     s     (irec,massemn,pbarun,pbarvn,wn,tetan,phin,
6     s     nrec,avant,airefin,phisfin,
7     s     tn,zmfu, zmfd, zen_u, zde_u,zen_d, zde_d, coefkzn,
8     s     yu1n,yv1n,ftsoln,pctsrfn,
9     s     frac_impan,frac_nucln,phisn)
10
11      IMPLICIT NONE
12
13#include "dimensions.h"
14#include "paramet.h"
15#include "comvert.h"
16#include "comconst.h"
17#include "comgeom2.h"
18#include "tracstoke.h"
19#include "logic.h"
20
21      integer irec,nrec,i,j
22      integer ig,l
23      integer imo,jmo,imn,jmn,ii,jj,ig
24      parameter (imn=iim,jmn=jjm,imo=imn/2,jmo=(jmn+1)/2)
25      integer ngrido,ngridn
26      parameter(ngrido=(jmo-1)*imo+2,ngridn=(jmn-1)*imn+2)
27      real zdtvr
28
29      INTEGER nbsrf
30      PARAMETER (nbsrf=4) ! nombre de sous-fractions pour une maille
31
32      real zmfd(ngridn,llm),zde_d(ngridn,llm),zen_d(ngridn,llm)
33      real zmfu(ngridn,llm),zde_u(ngridn,llm),zen_u(ngridn,llm)
34       
35       logical avant
36
37      real massefi(ngridn,llm)
38
39      real massemn(imn+1,jmn+1,llm),tetan(imn+1,jmn+1,llm)
40      real pbarun(imn+1,jmn+1,llm),pbarvn(imn+1,jmn,llm)
41      real wn(imn+1,jmn+1,llm),phin(imn+1,jmn+1,llm)
42      real phisn(imn+1,jmn+1)
43
44      real massemo(imo+1,jmo+1,llm),tetao(imo+1,jmo+1,llm)
45      real pbaruo(imo+1,jmo+1,llm),pbarvo(imo+1,jmo,llm)
46      real wo(imo+1,jmo+1,llm),phio(imo+1,jmo+1,llm)
47      real phiso(imo+1,jmo+1)
48
49      real pbarvst(imo+1,jmo+1,llm)
50
51      real tmpo2(imo+1,jmo+1,llm),tmpo1(imo,jmo+1,llm)
52      real tmpo4(imo+1,jmo+1,nbsrf),tmpo3(imo,jmo+1,nbsrf)
53      real tmpo6(imo+1,jmo+1),tmpo5(imo,jmo+1)
54      real tmpn6(imn+1,jmn+1),tmpn5(imn,jmn+1)
55      real tmpn2(imn+1,jmn+1,llm),tmpn1(imn,jmn+1,llm)
56      real tmpn4(imn+1,jmn+1,nbsrf),tmpn3(imn,jmn+1,nbsrf)
57
58        real airefio(ngrido),phisfio(ngrido),
59     .    mfuo(ngrido,llm),mfdo(ngrido,llm),en_uo(ngrido,llm),
60     .    de_uo(ngrido,llm),en_do(ngrido,llm),
61     .    de_do(ngrido,llm),coefkzo(ngrido,llm),
62     .    frac_impao(ngrido,llm),frac_nuclo(ngrido,llm),
63     .    yu1o(ngrido),yv1o(ngrido),ftsolo(ngrido,nbsrf),
64     .    pctsrfo(ngrido,nbsrf),to(ngrido,llm)
65
66      real airefin(ngridn),phisfin(ngridn),
67     .    mfun(ngridn,llm),en_un(ngridn,llm),mfdn(ngridn,llm),
68     .    de_un(ngridn,llm),en_dn(ngridn,llm),
69     .    de_dn(ngridn,llm),coefkzn(ngridn,llm),
70     .    frac_impan(ngridn,llm),frac_nucln(ngridn,llm),
71     .    ftsoln(ngridn,nbsrf),yu1n(ngridn),yv1n(ngridn),
72     .    pctsrfn(ngridn,nbsrf),tn(ngridn,llm)
73
74      real zcontrole(ngridn),zmass,tmpdyn(imn+1,jmn+1),zflux
75
76      real ziadvtrac,ziadvtrac2,zrec2
77      integer zim,zjm,zlm,zklon,zklev,zrec
78
79      real zpi
80
81c  longitudes et latitudes lues
82      real rlonul(imo+1,jmo+1),rlatvl(imo+1,jmo)
83      real rlonvl(imo+1,jmo),rlatul(imo+1,jmo+1)
84c  longitudes et latitudes anciennes
85      real rlonuo(0:imo+1),rlatvo(0:jmo+1)
86      real rlonvo(0:imo+1),rlatuo(0:jmo+1)
87c  longitudes et latitudes nouvelles
88      real rlonun(0:imn+1),rlatvn(0:jmn+1)
89      real rlonvn(0:imn+1),rlatun(0:jmn+1)
90      real aireo(imo+1,jmo+1)
91
92      integer ndecx(imo+1),ndecy(jmo+1)
93      real alphax(imn+1),alphay(jmn+1)
94      real alphaxo(imo+1)
95      real alpha(imn+1,jmn+1)
96       real alphat(imn+1,jmn+1,llm)
97      real aa,uu(0:imo+1),vv(imo+1,0:jmo+1)
98
99
100      integer iest(imo+1),iouest(imo+1)
101      integer jsud(jmo+1),jnord(jmo+1)
102
103      integer in,io,jn,jo,l,iin,jjn
104      integer i,j
105      real dlatm,dlatp,dlonm,dlonp
106c abd
107       character*10 file
108       character*10 nom
109       character*2 str2
110c fin ab
111      zpi=2.*asin(1.)
112
113
114c==================================================================
115c   Si le numero du record est 0 alors: INITIALISATION
116c==================================================================
117c
118      print*,'ENTREE DANS LECTFLUX'
119        print*,'IREC=',IREC
120      if(irec.eq.0) then
121
122        print*,'IREC==',0
123
124C test         call inigeom
125c==================================================================
126c   Definition des surdecoupages dans les deux directions
127c==================================================================
128
129      ndecx(1)=1
130      do io=2,imo
131         ndecx(io)=2
132      enddo
133      ndecx(imo+1)=1
134
135      ndecy(1)=1
136      do jo=2,jmo
137         ndecy(jo)=2
138      enddo
139      ndecy(jmo+1)=1
140
141      ii=0
142      do io=1,imo+1
143         ii=ii+ndecx(io)
144      enddo
145      if(ii.ne.iim) then
146         print*,'ii=',ii,'   iim=',iim
147         stop
148      endif
149
150      jj=0
151      do jo=1,jmo+1
152         jj=jj+ndecy(jo)
153      enddo
154      if(jj.ne.jjp1) then
155         print*,'jj=',jj,'   jjm=',jjm
156         stop
157      endif
158
159c==================================================================
160c   Calcul des jsud,... correspondant aux intersections des
161c   grilles.
162c==================================================================
163
164      iest(1)=0
165        print*,'iest(1)=0'
166      do io=2,imo+1
167         iest(io)=iest(io-1)+ndecx(io-1)
168         iouest(io-1)=iest(io)
169        print*,'iest(',io,')=',iest(io),'iouest('
170     s              ,io-1,')=',iouest(io-1)
171       
172      enddo
173      iouest(imo+1)=iest(imo+1)+ndecx(imo+1)
174        print*,'iouest(',imo+1,')=',iouest(imo+1)
175
176      jnord(1)=0
177        print*,'jnord(1)=0'
178      do jo=2,jmo+1
179         jnord(jo)=jnord(jo-1)+ndecy(jo-1)
180         jsud(jo-1)=jnord(jo)
181        print*,'jnord(',jo,')=',jnord(jo),'jsud('
182     s              ,jo-1,')=',jsud(jo-1)
183      enddo
184      jsud(jmo+1)=jnord(jmo+1)+ndecy(jmo+1)
185                print*,'jsud(',jmo+1,')=',jsud(jmo+1)
186
187c==================================================================
188c   ouverture des fichiers, lecture des entetes
189c==================================================================
190       
191        CALL read_dstoke(0,zdtvr,ziadvtrac,ziadvtrac2)
192
193        CALL read_fstoke(0,
194     .   zrec,zim,zjm,zlm,
195     .   rlonul,rlonvl,rlatul,rlatvl,aireo,phiso,
196     .   massemo,pbaruo,pbarvo,wo,tetao,phio)
197     
198      print*,'zrec,zdtvr,ziadvtrac,zim,zjm,zlm'
199      print*,zrec,zdtvr,ziadvtrac,zim,zjm,zlm
200
201      nrec=zrec
202      dtvr=zdtvr
203      istdyn=ziadvtrac
204      istphy=ziadvtrac2
205
206      print*,'rlonul '
207      do io=1,imo+1
208         print*,io,rlonul(io,1)
209      enddo
210        print*,'rlonvl '
211      do io=1,imo+1
212         print*,io,rlonvl(io,1)
213      enddo
214        print*,'rlatul '
215      do jo=1,jmo+1
216         print*,jo,rlatul(1,jo)
217      enddo
218        print*,'rlatvl'
219      do jo=1,jmo
220         print*,jo,rlatvl(1,jo)
221      enddo
222     
223c      if((imo-nint(zim))*(jmo-nint(zjm)).ne.0) then
224c        print*,'Modifier les dimensions dans redecoupe '
225c        print*,'Mettre imo=',zim,'   jmo=',zjm
226c  abderr      stop
227c      endif
228
229c abderrahmane
230        if(physic)then
231        CALL read_pstoke(0,
232     .   zrec,zklon,zklev,airefio,phisfio,
233     .   to,mfuo,mfdo,en_uo,de_uo,en_do,de_do,coefkzo,
234     .   frac_impao,frac_nuclo,yu1o,yv1o,ftsolo,pctsrfo)
235       
236        print*,'Entete du fichier physique'
237        print*,zrec,zklon,zklev
238        endif
239
240
241c==================================================================
242c   Definition des anciennes latitudes et longitudes
243c   (qui pourraient etre relues plus tard)
244c==================================================================
245
246
247      do io=1,imo
248         rlonuo(io)=rlonul(io,1)*zpi/180.
249        print*,'LON ',io,rlonuo(io)*180./zpi
250      enddo
251c abderr
252      rlonuo(imo+1)=0.5*(rlonul(imo,1)+rlonul(imo+1,1))*zpi/180.
253      print*,'LON ',imo+1,rlonuo(imo+1)*180./zpi
254      rlonuo(0)=rlonuo(imo+1)-2.*zpi
255      print*,'LON ',0,rlonuo(0)*180./zpi
256
257c abder
258c ATTENTION A REVOIR
259c       goto 22
260      do io=1,imo
261         rlonvo(io)=rlonvl(io,1)*zpi/180.
262        print*,'LON ',io,rlonvo(io)*180./zpi
263      enddo
264      rlonvo(imo+1)=0.5*(rlonvl(imo,1)+rlonvl(imo+1,1))*zpi/180.
265      print*,'LON ',imo+1,rlonvo(imo+1)*180./zpi
266      rlonvo(0)=rlonvo(imo+1)-2.*zpi
267      print*,'LON ',0,rlonvo(0)*180./zpi
26822    continue
269c fin ab
270
271      rlatvo(0)=zpi/2.
272      print*,'LAT ',0,rlatvo(0)*180./zpi
273      do jo=1,jmo
274        rlatvo(jo)=rlatvl(1,jo)*zpi/180.
275        print*,'LAT ',jo,rlatvo(jo)*180./zpi
276      enddo
277        rlatvo(jmo+1)=-zpi/2.
278        print*,'LAT ',jmo+1,rlatvo(jmo+1)*180./zpi
279c abd
280c ATTENTION A REVOIR
281c       goto 33
282c      rlatuo(0)=zpi/2.
283c      print*,'LAT ',0,rlatuo(0)*180./zpi
284      do jo=1,jmo+1
285        rlatuo(jo-1)=rlatul(1,jo)*zpi/180.
286        print*,'LAT ',jo-1,rlatuo(jo-1)*180./zpi
287      enddo
288        rlatuo(jmo+1)=-zpi/2.
289        print*,'LAT ',jmo+1,rlatuo(jmo+1)*180./zpi
29033    continue
291c abd
292
293      do io=2,imo
294         alphaxo(io)=1.
295      enddo
296      alphaxo(1)=(rlonuo(1)-rlonuo(0))
297     s        /(rlonuo(1)-rlonuo(0)+rlonuo(imo+1)-rlonuo(imo))
298      alphaxo(imo+1)=1.-alphaxo(1)
299
300c==================================================================
301c    Definition des nouvelles latitudes et longitudes
302c==================================================================
303
304c Nouvelles longitudes rlonun
305      rlonun(0)=rlonuo(0)
306      do io=1,imo+1
307         do iin=1,iouest(io)-iest(io)
308            in=iin+iest(io)
309            rlonun(in)=
310     s      rlonuo(io-1)+iin*(rlonuo(io)-rlonuo(io-1))
311     s      /ndecx(io)
312            alphax(in)=alphaxo(io)/ndecx(io)
313            print787,io,rlonuo(io-1)*180./zpi,in
314     s  ,iest(io),iouest(io),rlonun(in)*180./zpi,alphax(in)
315         enddo
316      enddo
317
318c Nouvelles longitudes rlonvn
319c       goto 44
320      rlonvn(0)=rlonvo(0)
321      do io=1,imo+1
322         do iin=1,iouest(io)-iest(io)
323            in=iin+iest(io)
324            rlonvn(in)=
325     s      rlonvo(io-1)+iin*(rlonvo(io)-rlonvo(io-1))
326     s      /ndecx(io)
327            alphax(in)=alphaxo(io)/ndecx(io)
328            print787,io,rlonvo(io-1)*180./zpi,in
329     s  ,iest(io),iouest(io),rlonvn(in)*180./zpi,alphax(in)
330         enddo
331      enddo
33244    continue
333
334c Nouvelles latitudes rlatvn
335      rlatvn(0)=0.5*zpi
336      do jo=1,jmo+1
337         do jjn=1,jsud(jo)-jnord(jo)
338            jn=jnord(jo)+jjn
339            rlatvn(jn)=
340     s      rlatvo(jo-1)+jjn*(rlatvo(jo)-rlatvo(jo-1))
341     s      /ndecy(jo)
342            alphay(jn)=(sin(rlatvn(jn-1))-sin(rlatvn(jn)))
343     s                /(sin(rlatvo(jo-1))-sin(rlatvo(jo)))
344           print*,jn,rlatvn(jn)*180./zpi
345         enddo
346      enddo
347
348c Nouvelles latitudes rlatun
349c       goto 55
350      rlatun(0)=0.5*zpi
351      do jo=1,jmo+1
352         do jjn=1,jsud(jo)-jnord(jo)
353            jn=jnord(jo)+jjn
354            rlatun(jn)=
355     s      rlatuo(jo-1)+jjn*(rlatuo(jo)-rlatuo(jo-1))
356     s      /ndecy(jo)
357           print*,jn,rlatvn(jn)*180./zpi
358         enddo
359      enddo
36055    continue
361
362787   format(i5,f10.2,3(i5),2(f12.6))
363      do in=1,imn
364         rlonu(in)=rlonun(in)
365         rlonv(in)=0.5*(rlonun(in)+rlonun(in-1))
366      enddo
367      rlonv(imn+1)=rlonv(1)+2.*zpi
368      rlonu(imn+1)=rlonu(1)+2.*zpi
369
370      do jn=1,jmn
371         rlatv(jn)=rlatvn(jn)
372      enddo
373      do jn=1,jmn+1
374         rlatu(jn)=0.5*(rlatvn(jn-1)+rlatvn(jn))
375      enddo
376
377      do jn=1,jmn+1
378         do in=1,imn
379            alpha(in,jn)=alphax(in)*alphay(jn)
380            alphat(in,jn,1)=alpha(in,jn)
381         enddo
382         alpha(imn+1,jn)=0.
383         alphat(imn+1,jn,1)=0.
384      enddo
385c abderr 19 4 00
386        do l=2,llm
387         do jn=1,jmn+1
388         do in=1,imn+1
389          alphat(in,jn,l)=alphat(in,jn,1)
390         enddo
391         enddo
392        enddo
393c     call dump2d(iip1,jjp1,alpha,'ALPHA   ')
394
395c      .  on a :  cu(i,j) = rad * COS(y) * dx/dX         .
396c      .          cv( j ) = rad          * dy/dY         .
397c   A 1 point scalaire P (i,j) de la grille, reguliere en (X,Y) , sont
398c   affectees 4 aires entourant P , calculees respectivement aux points
399c            ( i + 1/4, j - 1/4 )    :    aireij1 (i,j)
400c            ( i + 1/4, j + 1/4 )    :    aireij2 (i,j)
401c            ( i - 1/4, j + 1/4 )    :    aireij3 (i,j)
402c            ( i - 1/4, j - 1/4 )    :    aireij4 (i,j)
403c
404c                             . V
405c
406c                 aireij4 .        . aireij1
407c
408c                   U .       . P      . U
409c
410c                 aireij3 .        . aireij2
411c
412c                             . V
413
414
415      do j=1,jjp1
416         do i=1,iim
417            dlonp=rlonun(i)-rlonv(i)
418            dlonm=rlonv(i)-rlonun(i-1)
419            dlatp=sin(rlatvn(j-1))-sin(rlatu(j))
420            dlatm=sin(rlatu(j))-sin(rlatvn(j))
421            aireij1 ( i,j ) = rad*rad*dlatp*dlonp
422            aireij2 ( i,j ) = rad*rad*dlatm*dlonp
423            aireij3 ( i,j ) = rad*rad*dlatm*dlonm
424            aireij4 ( i,j ) = rad*rad*dlatp*dlonm
425      aire    ( i,j )  = aireij1(i,j) + aireij2(i,j) + aireij3(i,j) +
426     *                          aireij4(i,j)
427      alpha1  ( i,j )  = aireij1(i,j) / aire(i,j)
428      alpha2  ( i,j )  = aireij2(i,j) / aire(i,j)
429      alpha3  ( i,j )  = aireij3(i,j) / aire(i,j)
430      alpha4  ( i,j )  = aireij4(i,j) / aire(i,j)
431      alpha1p2( i,j )  = alpha1 (i,j) + alpha2 (i,j)
432      alpha1p4( i,j )  = alpha1 (i,j) + alpha4 (i,j)
433      alpha2p3( i,j )  = alpha2 (i,j) + alpha3 (i,j)
434      alpha3p4( i,j )  = alpha3 (i,j) + alpha4 (i,j)
435           enddo
436           aireij1(iip1,j)=aireij1(1,j)
437           aireij2(iip1,j)=aireij2(1,j)
438           aireij3(iip1,j)=aireij3(1,j)
439           aireij4(iip1,j)=aireij4(1,j)
440           aire(iip1,j)=aire(1,j)
441           alpha1(iip1,j)=alpha1(1,j)
442           alpha2(iip1,j)=alpha2(1,j)
443           alpha3(iip1,j)=alpha3(1,j)
444           alpha4(iip1,j)=alpha4(1,j)
445           alpha1p2(iip1,j)=alpha1p2(1,j)
446           alpha1p4(iip1,j)=alpha1p4(1,j)
447           alpha2p3(iip1,j)=alpha2p3(1,j)
448           alpha3p4(iip1,j)=alpha3p4(1,j)
449       enddo
450c     call dump2d(iip1,jjp1,aire,'AIRE   ')
451
452      DO 42 j = 1,jjp1
453      DO 41 i = 1,iim
454      unsaire(i,j) = 1./ aire(i,j)
455      aireu  (i,j) = aireij1(i,j) + aireij2(i,j) + aireij4(i+1,j) +
456     *                           aireij3(i+1,j)
457  41  CONTINUE
458      aireu  (iip1,j) = aireu  (1,j)
459      unsaire(iip1,j) = unsaire(1,j)
460  42  CONTINUE
461      DO 48 j = 1,jjm
462        DO i=1,iim
463         airev(i,j)     = aireij2(i,j)+ aireij3(i,j)+ aireij1(i,j+1) +
464     *                           aireij4(i,j+1)
465        ENDDO
466       airev   (iip1,j) = airev(1,j)
467  48  CONTINUE
468      apoln=0.
469      apols=0.
470      do i=1,iim
471         apoln=apoln+aire(i,1)
472         apols=apols+aire(i,jjp1)
473      enddo
474
475
476
477      do jn=1,jjp1
478         do in=1,iim
479            cu(in,jn)=rad*cos(rlatu(jn))*(rlonv(in+1)-rlonv(in))
480         enddo
481         cu(iip1,jn)=cu(1,jn)
482      enddo
483      do jn=1,jjm
484         do in=1,iim+1
485            cv(in,jn)=rad*(rlatu(jn)-rlatu(jn+1))
486         enddo
487      enddo
488        Print*,'Fin irec=0'
489        go to 435
490      file='pbur'
491      call inigrads(11,iip1
492     s  ,rlonu,180./pi,-180.,180.,jjp1,rlatu,-90.,90.,180./pi
493     s  ,llm,presnivs,1.
494     s  ,1800.,file,'gcmq2 ')
495      file='pbvr'
496      call inigrads(12,iip1
497     s  ,rlonv,180./pi,-180.,180.,jjm,rlatv,-90.,90.,180./pi
498     s  ,llm,presnivs,1.
499     s  ,1800.,file,'gcmq2 ')
500435   continue
501c==================================================================
502c   Fin des initialisations
503      else ! irec=0
504c==================================================================
505
506
507c-----------------------------------------------------------------------
508c   Lecture des fichiers fluxmass et  physique:
509c   -----------------------------------------------------
510        print*,'Entrer dans read_fstoke a irec=',irec
511        CALL read_fstoke(irec,
512     .   zrec,zim,zjm,zlm,
513     .   rlonul,rlonvl,rlatul,rlatvl,aireo,phiso,
514     .   massemo,pbaruo,pbarvo,wo,tetao,phio)
515
516        print*,'Apres read_fstoke a irec=',irec
517
518c       do l=1,llm
519c           do j=1,jmo
520c              do i=1,imo+1
521c                 pbarvo(i,j,l)=pbarvst(i,j,l)
522c              enddo
523c           enddo
524c        enddo
525
526         do l=1,llm
527            do jo=1,jmo+1
528               do io=1,imo+1
529                  do jn=jnord(jo)+1,jsud(jo)
530                     do in=iest(io)+1,iouest(io)
531c                        wn(in,jn,l)=alpha(in,jn)*wo(io,jo,l)
532c                        massemn(in,jn,l)=alpha(in,jn)
533                       wn(in,jn,l)=alphat(in,jn,l)*wo(io,jo,l)
534                       massemn(in,jn,l)=alphat(in,jn,l)
535     s                                *massemo(io,jo,l)
536                        tetan(in,jn,l)=tetao(io,jo,l)
537                        phin(in,jn,l)=phio(io,jo,l)
538                     enddo
539                  enddo
540               enddo
541            enddo
542            do jn=1,jmn+1
543               wn(imn+1,jn,l)=wn(1,jn,l)
544               massemn(imn+1,jn,l)=massemn(1,jn,l)
545               tetan(imn+1,jn,l)=tetan(1,jn,l)
546               phin(imn+1,jn,l)=phin(1,jn,l)
547            enddo
548         enddo
549c Test massemn
550        print*,'MASSE DANS LA NOUVELLE GRILLE'
551        goto 908
552        do jo=1,jmo+1
553               do io=1,imo+1
554                  do jn=jnord(jo)+1,jsud(jo)
555                     do in=iest(io)+1,iouest(io)
556        print*,'massemn(',in,jn,1,')=',massemn(in,jn,1)
557                     enddo
558                  enddo
559               enddo
560        enddo
561        do jn=1,jmn+1
562        print*,'massemn(',imn+1,jn,1,')=',massemn(imn+1,jn,1)
563        enddo
564908     continue
565        print*,'Fin calcul de massemn pour nouv. gril.'
566         do l=1,llm
567            do jo=1,jmo+1
568               uu(imo+1)=0.5*(pbaruo(imo,jo,l)+pbaruo(imo+1,jo,l))
569               uu(0)=uu(imo+1)
570               do io=1,imo
571                  uu(io)=pbaruo(io,jo,l)
572               enddo
573               do io=1,imo+1
574                  do jn=jnord(jo)+1,jsud(jo)
575                     aa=0.
576                     do in=iest(io)+1,iouest(io)
577                        aa=aa+alphax(in)
578                        pbarun(in,jn,l)=alphay(jn)*
579     s                    (uu(io-1)+aa*(uu(io)-uu(io-1)))
580                     enddo
581                  enddo
582               enddo
583            enddo
584            do jn=1,jmn+1
585               pbarun(imn+1,jn,l)=pbarun(1,jn,l)
586            enddo
587         enddo
588        print*,'Fin calcul de pbarun'
589       
590        do l=1,llm
591            do jo=1,jmo
592               do io=1,imo+1
593                  vv(io,jo)=pbarvo(io,jo,l)
594               enddo
595            enddo
596            do io=1,imo+1
597               vv(io,0)=0.
598               vv(io,jmo+1)=0.
599            enddo
600            do jo=1,jmo+1
601               do io=1,imo+1
602                  aa=0.
603c                 do jn=jnord(jo)+1,max(jsud(jo),jmo)
604                  do jn=jnord(jo)+1,min(jsud(jo),jmn)
605                     aa=aa+alphay(jn)
606                     do in=iest(io)+1,iouest(io)
607                        pbarvn(in,jn,l)=alphax(in)*
608     s                  (vv(io,jo-1)+aa*(vv(io,jo)-vv(io,jo-1)))
609                     enddo
610                  enddo
611               enddo
612            enddo
613            do jn=1,jmn
614               pbarvn(iip1,jn,l)=pbarvn(1,jn,l)
615            enddo
616         enddo
617
618c abd
619        go to 456
620        nom='pbaru'
621        call wrgrads(11,llm,pbarun(:,:,1),nom,nom)
622        nom='pbarv'
623        call wrgrads(12,llm,pbarvn(:,:,1),nom,nom)
624        nom='masse'
625        call wrgrads(11,llm,massemn(:,:,1),nom,nom)
626        nom='w'
627        call wrgrads(11,llm,wn(:,:,1),nom,nom)
628456     continue
629c fin ab
630
631        if(physic)then
632        CALL read_pstoke(irec,
633     .   zrec,zklon,zklev,airefio,phisfio,
634     .   to,mfuo,mfdo,en_uo,de_uo,en_do,de_do,coefkzo,
635     .   frac_impao,frac_nuclo,yu1o,yv1o,ftsolo,pctsrfo)
636        print*,'OK read_pstoke pour irec=',irec
637c==================================================================
638c  Passage  a la nouvelle grille
639c==================================================================
640        call gr_fi_ecrit(llm,ngrido,imo,jmo+1,to,tmpo1)
641        do l=1,llm
642           do jo=1,jmo+1
643              do io=1,imo
644                tmpo2(io,jo,l)=tmpo1(io,jo,l)
645              enddo
646           enddo
647
648                tmpo2(imo+1,1,l)=to(1,l)
649                tmpo2(imo+1,jmo+1,l)=to(ngrido,l)
650            do jo=2,jmo
651                tmpo2(imo+1,jo,l)=tmpo1(1,jo,l)
652            enddo
653c   passage a la grillle dynamique nouvelle
654            do jo=1,jmo+1
655               do io=1,imo+1
656                  do jn=jnord(jo)+1,jsud(jo)
657                     do in=iest(io)+1,iouest(io)
658                        tmpn2(in,jn,l)=tmpo2(io,jo,l)
659                     enddo
660                  enddo
661               enddo
662            enddo
663            do jn=1,jmn+1
664               do in=1,imn
665                tmpn1(in,jn,l)=tmpn2(in,jn,l)
666               enddo
667            enddo
668        enddo
669        call gr_ecrit_fi(llm,ngridn,imn,jmn+1,tmpn1,tn)
670        call initial0(llm*(imo+1)*(jmo+1),tmpo2)
671        call initial0(llm*imo*(jmo+1),tmpo1)
672        call initial0(llm*imn*(jmn+1),tmpn1)
673        call initial0(llm*(imn+1)*(jmn+1),tmpn2)
674
675        call gr_fi_ecrit(llm,ngrido,imo,jmo+1,mfuo,tmpo1)
676        do l=1,llm
677           do jo=1,jmo+1
678              do io=1,imo
679                tmpo2(io,jo,l)=tmpo1(io,jo,l)
680              enddo
681           enddo
682
683                tmpo2(imo+1,1,l)=mfuo(1,l)
684                tmpo2(imo+1,jmo+1,l)=mfuo(ngrido,l)
685            do jo=2,jmo
686                tmpo2(imo+1,jo,l)=tmpo1(1,jo,l)
687            enddo
688c   passage a la grillle dynamique nouvelle
689            do jo=1,jmo+1
690               do io=1,imo+1
691                  do jn=jnord(jo)+1,jsud(jo)
692                     do in=iest(io)+1,iouest(io)
693                        tmpn2(in,jn,l)=tmpo2(io,jo,l)
694                     enddo
695                  enddo
696               enddo
697            enddo
698            do jn=1,jmn+1
699               do in=1,imn
700                tmpn1(in,jn,l)=tmpn2(in,jn,l)
701               enddo
702            enddo
703        enddo
704        call gr_ecrit_fi(llm,ngridn,imn,jmn+1,tmpn1,mfun)
705        call initial0(llm*(imo+1)*(jmo+1),tmpo2)
706        call initial0(llm*imo*(jmo+1),tmpo1)
707        call initial0(llm*imn*(jmn+1),tmpn1)
708        call initial0(llm*(imn+1)*(jmn+1),tmpn2)
709        call gr_fi_ecrit(llm,ngrido,imo,jmo+1,mfdo,tmpo1)
710        do l=1,llm
711           do jo=1,jmo+1
712              do io=1,imo
713                tmpo2(io,jo,l)=tmpo1(io,jo,l)
714              enddo
715           enddo
716
717                tmpo2(imo+1,1,l)=mfdo(1,l)
718                tmpo2(imo+1,jmo+1,l)=mfdo(ngrido,l)
719            do jo=2,jmo
720                tmpo2(imo+1,jo,l)=tmpo1(1,jo,l)
721            enddo
722c   passage a la grillle dynamique nouvelle
723            do jo=1,jmo+1
724               do io=1,imo+1
725                  do jn=jnord(jo)+1,jsud(jo)
726                     do in=iest(io)+1,iouest(io)
727                        tmpn2(in,jn,l)=tmpo2(io,jo,l)
728                     enddo
729                  enddo
730               enddo
731            enddo
732            do jn=1,jmn+1
733               do in=1,imn
734                tmpn1(in,jn,l)=tmpn2(in,jn,l)
735               enddo
736            enddo
737        enddo
738        call gr_ecrit_fi(llm,ngridn,imn,jmn+1,tmpn1,mfdn)
739        call initial0(llm*(imo+1)*(jmo+1),tmpo2)
740        call initial0(llm*imo*(jmo+1),tmpo1)
741        call initial0(llm*imn*(jmn+1),tmpn1)
742        call initial0(llm*(imn+1)*(jmn+1),tmpn2)
743        call gr_fi_ecrit(llm,ngrido,imo,jmo+1,en_uo,tmpo1)
744        do l=1,llm
745           do jo=1,jmo+1
746              do io=1,imo
747                tmpo2(io,jo,l)=tmpo1(io,jo,l)
748              enddo
749           enddo
750
751                tmpo2(imo+1,1,l)=en_uo(1,l)
752                tmpo2(imo+1,jmo+1,l)=en_uo(ngrido,l)
753            do jo=2,jmo
754                tmpo2(imo+1,jo,l)=tmpo1(1,jo,l)
755            enddo
756c   passage a la grillle dynamique nouvelle
757            do jo=1,jmo+1
758               do io=1,imo+1
759                  do jn=jnord(jo)+1,jsud(jo)
760                     do in=iest(io)+1,iouest(io)
761                        tmpn2(in,jn,l)=tmpo2(io,jo,l)
762                     enddo
763                  enddo
764               enddo
765            enddo
766            do jn=1,jmn+1
767               do in=1,imn
768                tmpn1(in,jn,l)=tmpn2(in,jn,l)
769               enddo
770            enddo
771        enddo
772        call gr_ecrit_fi(llm,ngridn,imn,jmn+1,tmpn1,en_un)
773        call initial0(llm*(imo+1)*(jmo+1),tmpo2)
774        call initial0(llm*imo*(jmo+1),tmpo1)
775        call initial0(llm*imn*(jmn+1),tmpn1)
776        call initial0(llm*(imn+1)*(jmn+1),tmpn2)
777        call gr_fi_ecrit(llm,ngrido,imo,jmo+1,en_do,tmpo1)
778        do l=1,llm
779           do jo=1,jmo+1
780              do io=1,imo
781                tmpo2(io,jo,l)=tmpo1(io,jo,l)
782              enddo
783           enddo
784
785                tmpo2(imo+1,1,l)=en_do(1,l)
786                tmpo2(imo+1,jmo+1,l)=en_do(ngrido,l)
787            do jo=2,jmo
788                tmpo2(imo+1,jo,l)=tmpo1(1,jo,l)
789            enddo
790c   passage a la grillle dynamique nouvelle
791            do jo=1,jmo+1
792               do io=1,imo+1
793                  do jn=jnord(jo)+1,jsud(jo)
794                     do in=iest(io)+1,iouest(io)
795                        tmpn2(in,jn,l)=tmpo2(io,jo,l)
796                     enddo
797                  enddo
798               enddo
799            enddo
800            do jn=1,jmn+1
801               do in=1,imn
802                tmpn1(in,jn,l)=tmpn2(in,jn,l)
803               enddo
804            enddo
805        enddo
806        call gr_ecrit_fi(llm,ngridn,imn,jmn+1,tmpn1,en_dn)
807        call initial0(llm*(imo+1)*(jmo+1),tmpo2)
808        call initial0(llm*imo*(jmo+1),tmpo1)
809        call initial0(llm*imn*(jmn+1),tmpn1)
810        call initial0(llm*(imn+1)*(jmn+1),tmpn2)
811        call gr_fi_ecrit(llm,ngrido,imo,jmo+1,de_do,tmpo1)
812        do l=1,llm
813           do jo=1,jmo+1
814              do io=1,imo
815                tmpo2(io,jo,l)=tmpo1(io,jo,l)
816              enddo
817           enddo
818
819                tmpo2(imo+1,1,l)=de_do(1,l)
820                tmpo2(imo+1,jmo+1,l)=de_do(ngrido,l)
821            do jo=2,jmo
822                tmpo2(imo+1,jo,l)=tmpo1(1,jo,l)
823            enddo
824c   passage a la grillle dynamique nouvelle
825            do jo=1,jmo+1
826               do io=1,imo+1
827                  do jn=jnord(jo)+1,jsud(jo)
828                     do in=iest(io)+1,iouest(io)
829                        tmpn2(in,jn,l)=tmpo2(io,jo,l)
830                     enddo
831                  enddo
832               enddo
833            enddo
834            do jn=1,jmn+1
835               do in=1,imn
836                tmpn1(in,jn,l)=tmpn2(in,jn,l)
837               enddo
838            enddo
839        enddo
840        call gr_ecrit_fi(llm,ngridn,imn,jmn+1,tmpn1,de_dn)
841        call initial0(llm*(imo+1)*(jmo+1),tmpo2)
842        call initial0(llm*imo*(jmo+1),tmpo1)
843        call initial0(llm*imn*(jmn+1),tmpn1)
844        call initial0(llm*(imn+1)*(jmn+1),tmpn2)
845        call gr_fi_ecrit(llm,ngrido,imo,jmo+1,de_uo,tmpo1)
846        do l=1,llm
847           do jo=1,jmo+1
848              do io=1,imo
849                tmpo2(io,jo,l)=tmpo1(io,jo,l)
850              enddo
851           enddo
852
853                tmpo2(imo+1,1,l)=de_uo(1,l)
854                tmpo2(imo+1,jmo+1,l)=de_uo(ngrido,l)
855            do jo=2,jmo
856                tmpo2(imo+1,jo,l)=tmpo1(1,jo,l)
857            enddo
858c   passage a la grillle dynamique nouvelle
859            do jo=1,jmo+1
860               do io=1,imo+1
861                  do jn=jnord(jo)+1,jsud(jo)
862                     do in=iest(io)+1,iouest(io)
863                        tmpn2(in,jn,l)=tmpo2(io,jo,l)
864                     enddo
865                  enddo
866               enddo
867            enddo
868            do jn=1,jmn+1
869               do in=1,imn
870                tmpn1(in,jn,l)=tmpn2(in,jn,l)
871               enddo
872            enddo
873        enddo
874        call gr_ecrit_fi(llm,ngridn,imn,jmn+1,tmpn1,de_un)
875        call initial0(llm*(imo+1)*(jmo+1),tmpo2)
876        call initial0(llm*imo*(jmo+1),tmpo1)
877        call initial0(llm*imn*(jmn+1),tmpn1)
878        call initial0(llm*(imn+1)*(jmn+1),tmpn2)
879        call gr_fi_ecrit(llm,ngrido,imo,jmo+1,coefkzo,tmpo1)
880        do l=1,llm
881           do jo=1,jmo+1
882              do io=1,imo
883                tmpo2(io,jo,l)=tmpo1(io,jo,l)
884              enddo
885           enddo
886
887           tmpo2(imo+1,1,l)=coefkzo(1,l)
888           tmpo2(imo+1,jmo+1,l)=coefkzo(ngrido,l)
889
890           do jo=2,jmo
891                tmpo2(imo+1,jo,l)=tmpo2(1,jo,l)
892           enddo
893        enddo
894             
895c   passage a la grillle dynamique nouvelle
896        do l=1,llm     
897            do jo=1,jmo+1
898               do io=1,imo+1
899                  do jn=jnord(jo)+1,jsud(jo)
900                     do in=iest(io)+1,iouest(io)
901                        tmpn2(in,jn,l)=tmpo2(io,jo,l)
902                     enddo
903                  enddo
904               enddo
905            enddo
906            do jn=1,jmn+1
907               do in=1,imn
908                tmpn1(in,jn,l)=tmpn2(in,jn,l)
909               enddo
910            enddo
911        enddo
912        call gr_ecrit_fi(llm,ngridn,imn,jmn+1,tmpn1,coefkzn)
913        call initial0(llm*(imo+1)*(jmo+1),tmpo2)
914        call initial0(llm*imo*(jmo+1),tmpo1)
915        call initial0(llm*imn*(jmn+1),tmpn1)
916        call initial0(llm*(imn+1)*(jmn+1),tmpn2)
917        call gr_fi_ecrit(llm,ngrido,imo,jmo+1,frac_impao,tmpo1)
918        do l=1,llm
919           do jo=1,jmo+1
920              do io=1,imo
921                tmpo2(io,jo,l)=tmpo1(io,jo,l)
922              enddo
923           enddo
924
925                tmpo2(imo+1,1,l)=frac_impao(1,l)
926                tmpo2(imo+1,jmo+1,l)=frac_impao(ngrido,l)
927            do jo=2,jmo
928                tmpo2(imo+1,jo,l)=tmpo1(1,jo,l)
929            enddo
930c   passage a la grillle dynamique nouvelle
931            do jo=1,jmo+1
932               do io=1,imo+1
933                  do jn=jnord(jo)+1,jsud(jo)
934                     do in=iest(io)+1,iouest(io)
935                        tmpn2(in,jn,l)=tmpo2(io,jo,l)
936                     enddo
937                  enddo
938               enddo
939            enddo
940            do jn=1,jmn+1
941               do in=1,imn
942                tmpn1(in,jn,l)=tmpn2(in,jn,l)
943               enddo
944            enddo
945        enddo
946        call gr_ecrit_fi(llm,ngridn,imn,jmn+1,tmpn1,frac_impan)
947        call initial0(llm*(imo+1)*(jmo+1),tmpo2)
948        call initial0(llm*imo*(jmo+1),tmpo1)
949        call initial0(llm*imn*(jmn+1),tmpn1)
950        call initial0(llm*(imn+1)*(jmn+1),tmpn2)
951        call gr_fi_ecrit(llm,ngrido,imo,jmo+1,frac_nuclo,tmpo1)
952        do l=1,llm
953           do jo=1,jmo+1
954              do io=1,imo
955                tmpo2(io,jo,l)=tmpo1(io,jo,l)
956              enddo
957           enddo
958
959                tmpo2(imo+1,1,l)=frac_nuclo(1,l)
960                tmpo2(imo+1,jmo+1,l)=frac_nuclo(ngrido,l)
961            do jo=2,jmo
962                tmpo2(imo+1,jo,l)=tmpo1(1,jo,l)
963            enddo
964c   passage a la grillle dynamique nouvelle
965            do jo=1,jmo+1
966               do io=1,imo+1
967                  do jn=jnord(jo)+1,jsud(jo)
968                     do in=iest(io)+1,iouest(io)
969                        tmpn2(in,jn,l)=tmpo2(io,jo,l)
970                     enddo
971                  enddo
972               enddo
973            enddo
974            do jn=1,jmn+1
975               do in=1,imn
976                tmpn1(in,jn,l)=tmpn2(in,jn,l)
977               enddo
978            enddo
979        enddo
980        call gr_ecrit_fi(llm,ngridn,imn,jmn+1,tmpn1,frac_nucln)
981
982        call gr_fi_ecrit(nbsrf,ngrido,imo,jmo+1,ftsolo,tmpo3)
983        do l=1,nbsrf
984           do jo=1,jmo+1
985              do io=1,imo
986                tmpo4(io,jo,l)=tmpo3(io,jo,l)
987              enddo
988           enddo
989
990                tmpo4(imo+1,1,l)=ftsolo(1,l)
991                tmpo4(imo+1,jmo+1,l)=ftsolo(ngrido,l)
992            do jo=2,jmo
993                tmpo4(imo+1,jo,l)=tmpo3(1,jo,l)
994            enddo
995c   passage a la grillle dynamique nouvelle
996            do jo=1,jmo+1
997               do io=1,imo+1
998                  do jn=jnord(jo)+1,jsud(jo)
999                     do in=iest(io)+1,iouest(io)
1000                        tmpn4(in,jn,l)=tmpo3(io,jo,l)
1001                     enddo
1002                  enddo
1003               enddo
1004            enddo
1005            do jn=1,jmn+1
1006               do in=1,imn
1007                tmpn3(in,jn,l)=tmpn4(in,jn,l)
1008               enddo
1009            enddo
1010        enddo
1011        call gr_ecrit_fi(nbsrf,ngridn,imn,jmn+1,tmpn3,ftsoln)
1012
1013        call initial0(nbsrf*(imo+1)*(jmo+1),tmpo4)
1014        call initial0(nbsrf*imo*(jmo+1),tmpo3)
1015        call initial0(nbsrf*imn*(jmn+1),tmpn3)
1016        call initial0(nbsrf*(imn+1)*(jmn+1),tmpn4)
1017        call gr_fi_ecrit(nbsrf,ngrido,imo,jmo+1,pctsrfo,tmpo3)
1018        do l=1,nbsrf
1019           do jo=1,jmo+1
1020              do io=1,imo
1021                tmpo4(io,jo,l)=tmpo3(io,jo,l)
1022              enddo
1023           enddo
1024
1025                tmpo4(imo+1,1,l)=pctsrfo(1,l)
1026                tmpo4(imo+1,jmo+1,l)=pctsrfo(ngrido,l)
1027            do jo=2,jmo
1028                tmpo4(imo+1,jo,l)=tmpo3(1,jo,l)
1029            enddo
1030c   passage a la grillle dynamique nouvelle
1031            do jo=1,jmo+1
1032               do io=1,imo+1
1033                  do jn=jnord(jo)+1,jsud(jo)
1034                     do in=iest(io)+1,iouest(io)
1035                        tmpn4(in,jn,l)=tmpo3(io,jo,l)
1036                     enddo
1037                  enddo
1038               enddo
1039            enddo
1040            do jn=1,jmn+1
1041               do in=1,imn
1042                tmpn3(in,jn,l)=tmpn4(in,jn,l)
1043               enddo
1044            enddo
1045        enddo
1046        call gr_ecrit_fi(nbsrf,ngridn,imn,jmn+1,tmpn3,pctsrfn)
1047
1048        call gr_fi_ecrit(1,ngrido,imo,jmo+1,yv1o,tmpo5)
1049
1050           do jo=1,jmo+1
1051              do io=1,imo
1052                tmpo6(io,jo)=tmpo5(io,jo)
1053              enddo
1054           enddo
1055
1056                tmpo6(imo+1,1)=yv1o(1)
1057                tmpo6(imo+1,jmo+1)=yv1o(ngrido)
1058            do jo=2,jmo
1059                tmpo6(imo+1,jo)=tmpo5(1,jo)
1060            enddo
1061c   passage a la grillle dynamique nouvelle
1062            do jo=1,jmo+1
1063               do io=1,imo+1
1064                  do jn=jnord(jo)+1,jsud(jo)
1065                     do in=iest(io)+1,iouest(io)
1066                        tmpn6(in,jn)=tmpo5(io,jo)
1067                     enddo
1068                  enddo
1069               enddo
1070            enddo
1071            do jn=1,jmn+1
1072               do in=1,imn
1073                tmpn5(in,jn)=tmpn6(in,jn)
1074               enddo
1075            enddo
1076        call gr_ecrit_fi(1,ngridn,imn,jmn+1,tmpn5,yv1n)
1077
1078        call initial0((imo+1)*(jmo+1),tmpo6)
1079        call initial0(imo*(jmo+1),tmpo5)
1080        call initial0(imn*(jmn+1),tmpn5)
1081        call initial0((imn+1)*(jmn+1),tmpn6)
1082        call gr_fi_ecrit(1,ngrido,imo,jmo+1,yu1o,tmpo5)
1083
1084           do jo=1,jmo+1
1085              do io=1,imo
1086                tmpo6(io,jo)=tmpo5(io,jo)
1087              enddo
1088           enddo
1089
1090                tmpo6(imo+1,1)=yu1o(1)
1091                tmpo6(imo+1,jmo+1)=yu1o(ngrido)
1092            do jo=2,jmo
1093                tmpo6(imo+1,jo)=tmpo5(1,jo)
1094            enddo
1095c   passage a la grillle dynamique nouvelle
1096            do jo=1,jmo+1
1097               do io=1,imo+1
1098                  do jn=jnord(jo)+1,jsud(jo)
1099                     do in=iest(io)+1,iouest(io)
1100                        tmpn6(in,jn)=tmpo5(io,jo)
1101                     enddo
1102                  enddo
1103               enddo
1104            enddo
1105            do jn=1,jmn+1
1106               do in=1,imn
1107                tmpn5(in,jn)=tmpn6(in,jn)
1108               enddo
1109            enddo
1110        call gr_ecrit_fi(1,ngridn,imn,jmn+1,tmpn5,yu1n)
1111c==================================================================
1112        if (avant) then
1113c Simu directe
1114         do l=1,llm
1115          do ig=1,ngridn
1116             zmfd(ig,l)=mfdn(ig,l)
1117             zmfu(ig,l)=mfun(ig,l)
1118             zen_d(ig,l)=en_dn(ig,l)
1119             zde_d(ig,l)=de_dn(ig,l)
1120             zen_u(ig,l)=en_un(ig,l)
1121             zde_u(ig,l)=de_un(ig,l)
1122          enddo
1123       enddo
1124      else
1125c   Simu retro
1126       do l=1,llm
1127          do ig=1,ngridn
1128             zmfd(ig,l)=-mfdn(ig,l)
1129             zmfu(ig,l)=-mfun(ig,l)
1130             zen_d(ig,l)=en_dn(ig,l)
1131             zde_d(ig,l)=de_dn(ig,l)
1132             zen_u(ig,l)=en_un(ig,l)
1133             zde_u(ig,l)=de_un(ig,l)
1134          enddo
1135       enddo
1136      endif
1137
1138c-----------------------------------------------------------------------
1139c   PETIT CONTROLE SUR LES FLUX CONVECTIFS...
1140c-----------------------------------------------------------------------
1141
1142         call gr_dyn_fi(llm,iip1,jjp1,ngridn,massemn,massefi)
1143
1144      print*,'Ap redec irec'
1145         do ig=1,ngridn
1146            zcontrole(ig)=1.
1147         enddo
1148c   zmass=(max(massemn(ig,l),massemn(ig,l-1))/airefin(ig)
1149         do l=2,llm
1150            do ig=1,ngridn
1151               zmass=max(massefi(ig,l),massefi(ig,l-1))/airefin(ig)
1152               zflux=max(abs(zmfu(ig,l)),abs(zmfd(ig,l)))*dtphys
1153               if(zflux.gt.0.9*zmass) then
1154                 zcontrole(ig)=min(zcontrole(ig),0.9*zmass/zflux)
1155               endif
1156            enddo
1157         enddo
1158
1159         do ig=1,ngridn
1160            if(zcontrole(ig).lt.0.99999) then
1161               print*,'ATTENTION !!! on reduit les flux de masse '
1162               print*,'convectifs au point ig=',ig
1163            endif
1164         enddo
1165
1166         call gr_fi_dyn(1,ngridn,iip1,jjp1,zcontrole,tmpdyn)
1167
1168         do l=1,llm
1169            do ig=1,ngridn
1170               zmfu(ig,l)=zmfu(ig,l)*zcontrole(ig)
1171               zmfd(ig,l)=zmfd(ig,l)*zcontrole(ig)
1172               zen_u(ig,l)=zen_u(ig,l)*zcontrole(ig)
1173               zde_u(ig,l)=zde_u(ig,l)*zcontrole(ig)
1174               zen_d(ig,l)=zen_d(ig,l)*zcontrole(ig)
1175               zde_d(ig,l)=zde_d(ig,l)*zcontrole(ig)
1176            enddo
1177         enddo
1178        endif ! physic
1179
1180      endif ! irec=0
1181
1182
1183      RETURN
1184      END
1185
1186
Note: See TracBrowser for help on using the repository browser.