source: trunk/LMDZ.GENERIC/libf/dyn3d/lectflux.F @ 536

Last change on this file since 536 was 135, checked in by aslmd, 14 years ago

CHANGEMENT ARBORESCENCE ETAPE 2 -- NON COMPLET
File size: 6.6 KB
Line 
1      SUBROUTINE lectflux(irec,massem,pbarun,pbarvn,wn,tetan,phin,
2     s     nrec,avant,airefi,
3     s     zmfu, zmfd, zen_u, zde_u,zen_d, zde_d, coefkz,
4     s     yu1,yv1,ftsol,pctsrf,
5     s     frac_impa,frac_nucl,phis)
6
7      IMPLICIT NONE
8
9#include "dimensions.h"
10#include "paramet.h"
11
12#include "comvert.h"
13#include "comconst.h"
14#include "comgeom2.h"
15
16#include "tracstoke.h"
17
18      integer irec,nrec,i,j
19
20      integer ngridmx,ig,l
21      parameter (ngridmx=iim*(jjm-1)+2)
22      INTEGER nbsrf
23      PARAMETER (nbsrf=4) ! nombre de sous-fractions pour une maille
24
25      real zmfd(ngridmx,llm),zde_d(ngridmx,llm),zen_d(ngridmx,llm)
26      real zmfu(ngridmx,llm),zde_u(ngridmx,llm),zen_u(ngridmx,llm)
27      real coefkz(ngridmx,llm)
28      real frac_impa(ngridmx,llm),frac_nucl(ngridmx,llm)
29      real yu1(ngridmx), yv1(ngridmx)
30      real ftsol(ngridmx,nbsrf),pctsrf(ngridmx,nbsrf)
31      integer imfu,imfd,ien_u,ide_u,
32     s      ien_d,ide_d,
33     s      icoefkz,izu1,izv1,
34     s      itsol,ipsf,
35     s      ilei, ilec
36      parameter(imfu=1,imfd=llm+1,ien_u=2*llm+1,ide_u=3*llm+1,
37     s      ien_d=4*llm+1,ide_d=5*llm+1,
38     s      icoefkz=6*llm+1,
39     s      ilei=7*llm+1,ilec=8*llm+1,
40     s      izu1=9*llm+1,izv1=9*llm+2,
41     s      itsol=9*llm+3,ipsf=9*llm+3+nbsrf)
42      logical avant
43
44      real massefi(ngridmx,llm)
45
46      real massem(ip1jmp1,llm),tetan(ip1jmp1,llm)
47      real pbarun(iip1,jjp1,llm),pbarvn(iip1,jjm,llm)
48      real pbarvst(iip1,jjp1,llm)
49      real wn(iip1,jjp1,llm),phin(iip1,jjp1,llm)
50      real phis(iip1,jjp1)
51
52      real airefi(ngridmx)
53
54      real xlecn(ngridmx,9*llm+2+2*nbsrf)
55
56      real zcontrole(ngridmx),zmass,tmpdyn(iip1,jjp1),zflux
57
58      real ziadvtrac,zrec,ziadvtrac2,zrec2
59      real zim,zjm,zlm,zklon,zklev
60
61      real zpi
62
63      zpi=2.*asin(1.)
64
65
66c==================================================================
67c   Si le numero du record est 0 alors: INITIALISATION
68c==================================================================
69c
70      print*,'ENTREE DANS LECTFLUX'
71        print*,'IREC=',IREC
72      if(irec.eq.0) then
73
74        print*,'IREC==',0
75
76C test         call inigeom
77
78c==================================================================
79c   ouverture des fichiers
80c==================================================================
81
82c   Fichier fluxmass
83#ifdef CRAY
84         CALL ASSIGN("assign -N ieee -F null f:fluxmass")
85#endif
86      open(47,file='fluxmass',form='unformatted',
87     s     access='direct'
88     s     ,recl=4*(6*ijp1llm))
89      read(47,rec=1) zrec,dtvr,ziadvtrac,zim,zjm,zlm,
90     s   rlonu,rlonv,rlatu,rlatv,aire
91     s    ,phis
92      print*,'zrec,dtvr,ziadvtrac,zim,zjm,zlm'
93      print*,zrec,dtvr,ziadvtrac,zim,zjm,zlm
94      print*,rlonv
95
96
97
98c  Fichier physique
99c  Fichier lessivage (supprime les donnees utiles sont dans "physique")
100#ifdef CRAY
101         CALL ASSIGN("assign -N ieee -F null f:physique")
102#endif
103      open(49,file='physique',form='unformatted',
104     s     access='direct'
105     s     ,recl=4*ngridmx*(9*llm+2+2*nbsrf))
106      read(49,rec=1) zrec2,ziadvtrac2,zklon,zklev
107      print*,'Entete du fichier physique'
108      print*,zrec2,ziadvtrac2,zklon,zklev
109
110      nrec=zrec
111      print*,'nrec=',nrec
112
113      istdyn=ziadvtrac
114      istphy=ziadvtrac2
115
116c==================================================================
117c   Fin des initialisations
118      else ! irec=0
119c==================================================================
120
121
122c-----------------------------------------------------------------------
123c   Lecture des fichiers fluxmass et  physique:
124c   -----------------------------------------------------
125
126c  Variables dynamiques
127         read(47,rec=irec) massem,pbarun,pbarvst,wn,tetan,phin
128        do l=1,llm
129           do j=1,jjm
130              do i=1,iip1
131                 pbarvn(i,j,l)=pbarvst(i,j,l)
132              enddo
133           enddo
134        enddo
135
136c  Variables physiques
137         read(49,rec=irec) ((xlecn(ig,l),ig=1,ngridmx),
138     s                                    l=1,9*llm+2+2*nbsrf)
139
140       do l=1,llm
141          do ig=1,ngridmx
142             coefkz(ig,l)=xlecn(ig,icoefkz+l-1)
143             frac_impa(ig,l)=xlecn(ig,ilei+l-1)
144             frac_nucl(ig,l)=xlecn(ig,ilec+l-1)
145          enddo
146       enddo
147       do l=1,nbsrf
148          do ig=1,ngridmx
149             ftsol(ig,l)=xlecn(ig,itsol+l-1)
150             pctsrf(ig,l)=xlecn(ig,ipsf+l-1)
151          enddo
152       enddo
153       do ig=1,ngridmx
154          yv1(ig)=xlecn(ig,izv1)
155          yu1(ig)=xlecn(ig,izu1)
156       enddo
157C
158      if(avant) then
159c   Simu directe
160       do l=1,llm
161          do ig=1,ngridmx
162             zmfu(ig,l)=xlecn(ig,imfu+l-1)
163             zmfd(ig,l)=xlecn(ig,imfd+l-1)
164             zde_u(ig,l)=xlecn(ig,ide_u+l-1)
165             zen_u(ig,l)=xlecn(ig,ien_u+l-1)
166             zde_d(ig,l)=xlecn(ig,ide_d+l-1)
167             zen_d(ig,l)=xlecn(ig,ien_d+l-1)
168          enddo
169       enddo
170      else
171c   Simu retro
172       do l=1,llm
173          do ig=1,ngridmx
174             zmfd(ig,l)=-xlecn(ig,imfu+l-1)
175             zmfu(ig,l)=-xlecn(ig,imfd+l-1)
176             zen_d(ig,l)=xlecn(ig,ide_u+l-1)
177             zde_d(ig,l)=xlecn(ig,ien_u+l-1)
178             zen_u(ig,l)=xlecn(ig,ide_d+l-1)
179             zde_u(ig,l)=xlecn(ig,ien_d+l-1)
180          enddo
181       enddo
182      endif
183
184c-----------------------------------------------------------------------
185c   PETIT CONTROLE SUR LES FLUX CONVECTIFS...
186c-----------------------------------------------------------------------
187
188      print*,'Ap redec irec'
189
190         call gr_dyn_fi(llm,iip1,jjp1,ngridmx,massem,massefi)
191
192         do ig=1,ngridmx
193            zcontrole(ig)=1.
194         enddo
195c   zmass=(max(massem(ig,l),massem(ig,l-1))/airefi(ig)
196         do l=2,llm
197            do ig=1,ngridmx
198               zmass=max(massefi(ig,l),massefi(ig,l-1))/airefi(ig)
199               zflux=max(abs(zmfu(ig,l)),abs(zmfd(ig,l)))*dtphys
200               if(zflux.gt.0.9*zmass) then
201                 zcontrole(ig)=min(zcontrole(ig),0.9*zmass/zflux)
202               endif
203            enddo
204         enddo
205
206         do ig=1,ngridmx
207            if(zcontrole(ig).lt.0.99999) then
208               print*,'ATTENTION !!! on reduit les flux de masse '
209               print*,'convectifs au point ig=',ig
210            endif
211         enddo
212
213         call gr_fi_dyn(1,ngridmx,iip1,jjp1,zcontrole,tmpdyn)
214
215         do l=1,llm
216            do ig=1,ngridmx
217               zmfu(ig,l)=zmfu(ig,l)*zcontrole(ig)
218               zmfd(ig,l)=zmfd(ig,l)*zcontrole(ig)
219               zen_u(ig,l)=zen_u(ig,l)*zcontrole(ig)
220               zde_u(ig,l)=zde_u(ig,l)*zcontrole(ig)
221               zen_d(ig,l)=zen_d(ig,l)*zcontrole(ig)
222               zde_d(ig,l)=zde_d(ig,l)*zcontrole(ig)
223            enddo
224         enddo
225
226
227      endif ! irec=0
228
229
230      RETURN
231      END
232
233
Note: See TracBrowser for help on using the repository browser.