source: LMDZ.3.3/trunk/libf/phylmd/phystoke.F @ 3

Last change on this file since 3 was 2, checked in by lmdz, 25 years ago

Initial revision

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 6.0 KB
Line 
1      SUBROUTINE phystoke (
2     I                   nlon,nlev,pdtphys,
3     I                   pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
4     I                   pcoefh,yu1,yv1,ftsol,pctsrf,
5     I                   frac_impa,frac_nucl)
6      IMPLICIT none
7
8c======================================================================
9c Auteur(s) FH
10c Objet: Moniteur general des tendances traceurs
11c
12
13c======================================================================
14#include "dimensions.h"
15#include "dimphy.h"
16#include "tracstoke.h"
17#include "indicesol.h"
18c======================================================================
19
20c Arguments:
21c
22c   EN ENTREE:
23c   ==========
24c
25c   divers:
26c   -------
27c
28      integer nlon ! nombre de points horizontaux
29      integer nlev ! nombre de couches verticales
30      real pdtphys ! pas d'integration pour la physique (seconde)
31c
32c   convection:
33c   -----------
34c
35      REAL pmfu(klon,klev)  ! flux de masse dans le panache montant
36      REAL pmfd(klon,klev)  ! flux de masse dans le panache descendant
37      REAL pen_u(klon,klev) ! flux entraine dans le panache montant
38      REAL pde_u(klon,klev) ! flux detraine dans le panache montant
39      REAL pen_d(klon,klev) ! flux entraine dans le panache descendant
40      REAL pde_d(klon,klev) ! flux detraine dans le panache descendant
41c
42c   Couche limite:
43c   --------------
44c
45      REAL pcoefh(klon,klev)    ! coeff melange CL
46      REAL yv1(klon)
47      REAL yu1(klon)
48c
49c   Lessivage:
50c   ----------
51c
52      REAL frac_impa(klon,klev)
53      REAL frac_nucl(klon,klev)
54c
55c Arguments necessaires pour les sources et puits de traceur
56C
57      real ftsol(klon,nbsrf)  ! Temperature du sol (surf)(Kelvin)
58      real pctsrf(klon,nbsrf) ! Pourcentage de sol f(nature du sol)
59
60c======================================================================
61c
62      INTEGER i, k
63c
64      REAL mfu(klon,klev)  ! flux de masse dans le panache montant
65      REAL mfd(klon,klev)  ! flux de masse dans le panache descendant
66      REAL en_u(klon,klev) ! flux entraine dans le panache montant
67      REAL de_u(klon,klev) ! flux detraine dans le panache montant
68      REAL en_d(klon,klev) ! flux entraine dans le panache descendant
69      REAL de_d(klon,klev) ! flux detraine dans le panache descendant
70      REAL coefh(klon,klev) ! flux detraine dans le panache descendant
71
72      REAL pyu1(klon),pyv1(klon)
73      REAL pftsol(klon,nbsrf),ppsrf(klon,nbsrf)
74
75      REAL dtcum
76
77      integer iadvtr,irec
78      real zmin,zmax
79
80      save mfu,mfd,en_u,de_u,en_d,de_d,coefh,dtcum
81      save iadvtr,irec
82      save pyu1,pyv1,pftsol,ppsrf
83
84      data iadvtr,irec/0,1/
85c
86c   Couche limite:
87c======================================================================
88
89      print*,'iadvtr= ',iadvtr
90      print*,'istphy= ',istphy
91      print*,'istdyn= ',istdyn
92
93      IF (iadvtr.eq.0) THEN
94#ifdef CRAY
95         CALL ASSIGN("assign -N ieee -F null f:physique")
96#endif
97         open(49,file='physique',form='unformatted',
98     s        access='direct',recl=4*klon*(9*klev+2+2*nbsrf))
99      ENDIF
100c
101      iadvtr=iadvtr+1
102c
103      IF(mod(iadvtr,istphy).eq.0) THEN
104c
105c   normalisation par le temps cumule
106         do k=1,klev
107            do i=1,klon
108               mfu(i,k)=mfu(i,k)/dtcum
109               mfd(i,k)=mfd(i,k)/dtcum
110               en_u(i,k)=en_u(i,k)/dtcum
111               de_u(i,k)=de_u(i,k)/dtcum
112               en_d(i,k)=en_d(i,k)/dtcum
113               de_d(i,k)=de_d(i,k)/dtcum
114               coefh(i,k)=coefh(i,k)/dtcum
115            enddo
116         enddo
117         do i=1,klon
118            pyv1(i)=pyv1(i)/dtcum
119            pyu1(i)=pyu1(i)/dtcum
120         end do
121         do k=1,nbsrf
122             do i=1,klon
123               pftsol(i,k)=pftsol(i,k)/dtcum
124               ppsrf(i,k)=ppsrf(i,k)/dtcum
125            enddo
126         enddo
127c
128c   ecriture des champs
129c
130         irec=irec+1
131         write(49,rec=1) float(irec),float(istphy),
132     s    float(klon),float(klev)
133         write(49,rec=irec) mfu,mfd,en_u,de_u,en_d,de_d
134     s        ,coefh
135     s        ,frac_impa,frac_nucl
136     s        ,pyu1,pyv1,pftsol,ppsrf
137c
138cAA Test sur la valeur des coefficients de lessivage
139c
140         zmin=1e33
141         zmax=-1e33
142         do k=1,klev
143            do i=1,klon
144                  zmax=max(zmax,frac_nucl(i,k))
145                  zmin=min(zmin,frac_nucl(i,k))
146            enddo
147         enddo
148         Print*,'------ coefs de lessivage (min et max) --------'
149         Print*,'facteur de nucleation ',zmin,zmax
150         zmin=1e33
151         zmax=-1e33
152         do k=1,klev
153            do i=1,klon
154                  zmax=max(zmax,frac_impa(i,k))
155                  zmin=min(zmin,frac_impa(i,k))
156            enddo
157         enddo
158         Print*,'facteur d impaction ',zmin,zmax
159
160      ENDIF
161
162c   reinitialisation des champs cumules
163      if (mod(iadvtr,istphy).eq.1) then
164         do k=1,klev
165            do i=1,klon
166               mfu(i,k)=0.
167               mfd(i,k)=0.
168               en_u(i,k)=0.
169               de_u(i,k)=0.
170               en_d(i,k)=0.
171               de_d(i,k)=0.
172               coefh(i,k)=0.
173            enddo
174         enddo
175         do i=1,klon
176            pyv1(i)=0.
177            pyu1(i)=0.
178         end do
179         do k=1,nbsrf
180             do i=1,klon
181               pftsol(i,k)=0.
182               ppsrf(i,k)=0.
183            enddo
184         enddo
185
186         dtcum=0.
187      endif
188
189      do k=1,klev
190         do i=1,klon
191            mfu(i,k)=mfu(i,k)+pmfu(i,k)*pdtphys
192            mfd(i,k)=mfd(i,k)+pmfd(i,k)*pdtphys
193            en_u(i,k)=en_u(i,k)+pen_u(i,k)*pdtphys
194            de_u(i,k)=de_u(i,k)+pde_u(i,k)*pdtphys
195            en_d(i,k)=en_d(i,k)+pen_d(i,k)*pdtphys
196            de_d(i,k)=de_d(i,k)+pde_d(i,k)*pdtphys
197            coefh(i,k)=coefh(i,k)+pcoefh(i,k)*pdtphys
198         enddo
199      enddo
200         do i=1,klon
201            pyv1(i)=pyv1(i)+yv1(i)*pdtphys
202            pyu1(i)=pyu1(i)+yu1(i)*pdtphys
203         end do
204         do k=1,nbsrf
205             do i=1,klon
206               pftsol(i,k)=pftsol(i,k)+ftsol(i,k)*pdtphys
207               ppsrf(i,k)=ppsrf(i,k)+pctsrf(i,k)*pdtphys
208            enddo
209         enddo
210
211      dtcum=dtcum+pdtphys
212
213      RETURN
214      END
Note: See TracBrowser for help on using the repository browser.