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

Last change on this file since 1422 was 1422, checked in by milmd, 10 years ago

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