source: LMDZ.3.3/trunk/libf/dyn3d/lectfluxnc.F @ 4031

Last change on this file since 4031 was 210, checked in by lmdz, 24 years ago

Changement de nom
LF
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 5.8 KB
Line 
1c
2c $Header$
3c
4      SUBROUTINE lectfluxnc(irec,massem,pbarun,pbarvn,wn,tetan,phin,
5     s     nrec,avant,airefi,phisfi,
6     s     t,zmfu, zmfd, zen_u, zde_u,zen_d, zde_d, coefkz,
7     s     yu1,yv1,ftsol,pctsrf,
8     s     frac_impa,frac_nucl,phis)
9
10      IMPLICIT NONE
11
12#include "dimensions.h"
13#include "paramet.h"
14#include "logic.h"
15#include "comvert.h"
16#include "comconst.h"
17#include "comgeom2.h"
18
19#include "tracstoke.h"
20
21      integer irec,nrec,i,j
22
23      integer klon,ig,l
24      parameter (klon=iim*(jjm-1)+2)
25      INTEGER nbsrf
26      PARAMETER (nbsrf=4) ! nombre de sous-fractions pour une maille
27
28c Convection
29      real*4 zmfd(klon,llm),zde_d(klon,llm),zen_d(klon,llm)
30      real*4 zmfu(klon,llm),zde_u(klon,llm),zen_u(klon,llm)
31      real*4 mfd(klon,llm),de_d(klon,llm),en_d(klon,llm)
32      real*4 mfu(klon,llm),de_u(klon,llm),en_u(klon,llm)
33        real*4 t(klon,llm)
34      real zdtvr
35       
36        real*4 airedy(iip1,jjp1)
37      real*4 rlonu_dy(iip1,jjp1),rlonv_dy(iip1,jjm),
38     . rlatu_dy(iip1,jjp1),rlatv_dy(iip1,jjm)
39
40      real*4 coefkz(klon,llm)
41      real*4 frac_impa(klon,llm),frac_nucl(klon,llm)
42      real*4 yu1(klon), yv1(klon)
43      real*4 ftsol(klon,nbsrf),pctsrf(klon,nbsrf)
44
45      logical avant
46
47      real massefi(klon,llm)
48
49c   Flux masse
50      real*4 massem(iip1,jjp1,llm),tetan(iip1,jjp1,llm)
51      real*4 pbarun(iip1,jjp1,llm),pbarvn(iip1,jjm,llm)
52      real*4 pbarvst(iip1,jjp1,llm)
53      real*4 wn(iip1,jjp1,llm),phin(iip1,jjp1,llm)
54      real*4 phis(iip1,jjp1)
55
56      real*4 airefi(klon),phisfi(klon)
57
58      real zcontrole(klon),zmass,tmpdyn(iip1,jjp1),zflux
59
60      real ziadvtrac,ziadvtrac2,zrec2
61      integer zim,zjm,zlm,zklon,zklev,zrec
62
63      real zpi
64
65      zpi=2.*asin(1.)
66
67
68c==================================================================
69c   Si le numero du record est 0 alors: INITIALISATION
70c==================================================================
71c
72      print*,'ENTREE DANS LECTFLUXNC'
73        print*,'IREC=',IREC
74
75      if(irec.eq.0) then
76
77        print*,'IREC==',0
78
79C test         call inigeom
80
81c==================================================================
82c   ouverture des fichiers
83c==================================================================
84       
85        CALL read_dstoke(0,zdtvr,ziadvtrac,ziadvtrac2)
86       
87        CALL read_fstoke0(0,
88     .  zrec,zim,zjm,zlm,
89     .   rlonu_dy,rlonv_dy,rlatu_dy,rlatv_dy,airedy,phis,
90     .   massem,pbarun,pbarvn,wn,tetan,phin)
91c
92        if(physic)then 
93        CALL read_pstoke0(0,
94     .   zrec,zklon,zklev,airefi,phisfi,
95     .   t,mfu,mfd,en_u,de_u,en_d,de_d,coefkz,
96     .   frac_impa,frac_nucl,yu1,yv1,ftsol,pctsrf)
97        endif
98       
99        dtvr=zdtvr     
100        nrec=zrec
101        print*,'nrec=',nrec
102       
103        print*, 'Lecture de defstoke.nc'
104        print*, 'Ds lectfluxnc dtvr = ', dtvr
105        print*, 'Ds lectfluxnc istdyn= ',ziadvtrac
106        print*, 'Ds lectfluxnc istphy= ',ziadvtrac2
107
108      istdyn=ziadvtrac
109      istphy=ziadvtrac2
110       
111c       pause
112
113c==================================================================
114c   Fin des initialisations
115      else ! irec=0
116c==================================================================
117
118
119c-----------------------------------------------------------------------
120c   Lecture des fichiers fluxmass et  physique:
121c   -----------------------------------------------------
122
123         CALL read_fstoke0(irec,
124     .   zrec,zim,zjm,zlm,
125     .   rlonu_dy,rlonv_dy,rlatu_dy,rlatv_dy,airedy,phis,
126     .   massem,pbarun,pbarvn,wn,tetan,phin)
127       
128        write(*,*) 'lectfluxnc aps read_fstoke irec',irec
129        if(physic)then
130        CALL read_pstoke0(irec,
131     .   zrec,zklon,zklev,airefi,phisfi,
132     .   t,mfu,mfd,en_u,de_u,en_d,de_d,coefkz,
133     .   frac_impa,frac_nucl,yu1,yv1,ftsol,pctsrf)
134       
135        write(*,*) 'lectfluxnc aps read_pstoke irec',irec
136       
137        if (avant) then
138c Simu directe
139       do l=1,llm
140          do ig=1,klon
141             zmfu(ig,l)=mfu(ig,l)
142             zmfd(ig,l)=mfd(ig,l)
143             zde_u(ig,l)=de_u(ig,l)
144             zen_u(ig,l)=en_u(ig,l)
145             zde_d(ig,l)=de_d(ig,l)
146             zen_d(ig,l)=en_d(ig,l)
147          enddo
148       enddo
149      else
150c   Simu retro
151       do l=1,llm
152          do ig=1,klon
153             zmfd(ig,l)=-mfu(ig,l)
154             zmfu(ig,l)=-mfd(ig,l)
155             zen_d(ig,l)=de_u(ig,l)
156             zde_d(ig,l)=en_u(ig,l)
157             zen_u(ig,l)=de_d(ig,l)
158             zde_u(ig,l)=en_d(ig,l)
159          enddo
160       enddo
161      endif
162
163c-----------------------------------------------------------------------
164c   PETIT CONTROLE SUR LES FLUX CONVECTIFS...
165c-----------------------------------------------------------------------
166
167      print*,'Ap redec irec'
168        write(*,*) 'dtphys = ', dtphys
169
170         call gr_dyn_fi(llm,iip1,jjp1,klon,massem,massefi)
171
172         do ig=1,klon
173            zcontrole(ig)=1.
174         enddo
175c   zmass=(max(massem(ig,l),massem(ig,l-1))/airefi(ig)
176         do l=2,llm
177            do ig=1,klon
178               zmass=max(massefi(ig,l),massefi(ig,l-1))/airefi(ig)
179               zflux=max(abs(zmfu(ig,l)),abs(zmfd(ig,l)))*dtphys
180               if(zflux.gt.0.9*zmass) then
181                 zcontrole(ig)=min(zcontrole(ig),0.9*zmass/zflux)
182               endif
183            enddo
184         enddo
185
186         do ig=1,klon
187            if(zcontrole(ig).lt.0.99999) then
188               print*,'ATTENTION !!! on reduit les flux de masse '
189               print*,'convectifs au point ig=',ig
190            endif
191         enddo
192       
193        write(*,*) 'lectfluxnc avt gr_fi_dyn'
194
195         call gr_fi_dyn(1,klon,iip1,jjp1,zcontrole,tmpdyn)
196       
197        write(*,*) 'lectfluxnc aps gr_fi_dyn'
198       
199         do l=1,llm
200            do ig=1,klon
201               zmfu(ig,l)=zmfu(ig,l)*zcontrole(ig)
202               zmfd(ig,l)=zmfd(ig,l)*zcontrole(ig)
203               zen_u(ig,l)=zen_u(ig,l)*zcontrole(ig)
204               zde_u(ig,l)=zde_u(ig,l)*zcontrole(ig)
205               zen_d(ig,l)=zen_d(ig,l)*zcontrole(ig)
206               zde_d(ig,l)=zde_d(ig,l)*zcontrole(ig)
207            enddo
208         enddo
209         endif
210       
211        write(*,*) 'lectfluxnc fin de boucle if'
212
213      endif ! irec=0
214
215      RETURN
216      END
217
218
Note: See TracBrowser for help on using the repository browser.