source: trunk/LMDZ.PLUTO/libf/phypluto/vdifc_pluto_mod.F90 @ 3252

Last change on this file since 3252 was 3247, checked in by afalco, 22 months ago

Added missing files from pluto.old

File size: 24.4 KB
Line 
1    module vdifc_pluto_mod
2
3    implicit none
4
5    contains
6
7    SUBROUTINE vdifc_pluto(ngrid,nlay,nq,ppopsk,                   &
8                     ptimestep,pcapcal,lecrit,               &
9                     pplay,pplev,pzlay,pzlev,pz0,            &
10                     pu,pv,ph,pq,pt,ptsrf,pemis,pqsurf,      &
11                     pdufi,pdvfi,pdhfi,pdqfi,pdtfi,pfluxsrf, &
12                     pdudif,pdvdif,pdhdif,pdtsrf,pq2,        &
13                     pdqdif,pdqsdif,qsat_ch4,qsat_ch4_l1)
14
15      use comgeomfi_h
16      use callkeys_mod, only: carbox, methane, condcosurf, condensn2, condmetsurf,&
17                              kmix_proffix, vertdiff, tracer, kmixmin
18      use datafile_mod, only: datadir
19      use surfdat_h, only: phisfi
20      use comcstfi_mod, only: g, rcp, cpp
21      use comconst_mod, only: r
22      USE tracer_h, only: igcm_ch4_gas, igcm_ch4_ice, igcm_co_gas, igcm_co_ice,&
23                          igcm_n2, lw_ch4, lw_co, lw_n2
24
25      implicit none
26
27!=======================================================================
28!
29!   subject:
30!   --------
31!   Turbulent diffusion (mixing) for potential T, U, V and tracer
32!
33!   Shema implicite
34!   On commence par rajouter au variables x la tendance physique
35!   et on resoult en fait:
36!      x(t+1) =  x(t) + dt * (dx/dt)phys(t)  +  dt * (dx/dt)difv(t+1)
37!
38!   author:
39!   ------
40!      Hourdin/Forget/Fournier
41!=======================================================================
42
43!-----------------------------------------------------------------------
44!   declarations:
45!   -------------
46
47#include "dimensions.h"
48
49!
50!   arguments:
51!   ----------
52
53      INTEGER ngrid,nlay
54      REAL ptimestep
55      REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1)
56      REAL pzlay(ngrid,nlay),pzlev(ngrid,nlay+1)
57      REAL pu(ngrid,nlay),pv(ngrid,nlay),ph(ngrid,nlay)
58      REAL ptsrf(ngrid),pemis(ngrid)
59      REAL pdufi(ngrid,nlay),pdvfi(ngrid,nlay),pdhfi(ngrid,nlay)
60      REAL pdtfi(ngrid,nlay)
61      REAL pt(ngrid,nlay)
62      REAL pfluxsrf(ngrid)
63      REAL pdudif(ngrid,nlay),pdvdif(ngrid,nlay),pdhdif(ngrid,nlay)
64      REAL pdtsrf(ngrid),pcapcal(ngrid)
65      REAL pq2(ngrid,nlay+1)
66      REAL qsat_ch4(ngrid)
67      REAL qsat_co(ngrid)
68      REAL qsat_ch4_l1(ngrid)
69      REAL zq1temp_ch4(ngrid)
70
71!    Argument added for condensation:
72!      REAL n2ice (ngrid)
73      REAL ppopsk(ngrid,nlay)
74      logical lecrit
75      REAL pz0
76
77!    Traceurs :
78      integer nq
79      REAL pqsurf(ngrid,nq)
80      real pq(ngrid,nlay,nq), pdqfi(ngrid,nlay,nq)
81      real pdqdif(ngrid,nlay,nq)
82      real pdqdifeddy(ngrid,nlay,nq)
83      real pdqsdif(ngrid,nq),pdqsdif1(ngrid,nq)
84
85!   local:
86!   ------
87
88      INTEGER ilev,ig,ilay,nlev
89
90      REAL z4st,zdplanck(ngrid)
91      REAL zkv(ngrid,nlay+1),zkh(ngrid,nlay+1)
92      REAL zcdv(ngrid),zcdh(ngrid),sat2(ngrid)
93      REAL zcdv_true(ngrid),zcdh_true(ngrid)
94      REAL zu(ngrid,nlay),zv(ngrid,nlay)
95      REAL zh(ngrid,nlay),zt(ngrid,nlay)
96      REAL ztsrf2(ngrid),sat(ngrid),sat1(ngrid)
97      REAL z1(ngrid),z2(ngrid)
98      REAL za(ngrid,nlay),zb(ngrid,nlay)
99      REAL zb0(ngrid,nlay)
100      REAL zc(ngrid,nlay),zd(ngrid,nlay)
101      REAL zcst1
102      REAL zu2
103
104      EXTERNAL SSUM,SCOPY
105      REAL SSUM
106      LOGICAL firstcall
107      SAVE firstcall
108
109      !!read fixed profile for kmix
110      integer Nfine,ifine
111      parameter(Nfine=701)
112      character(len=100) :: file_path
113      real,save :: levdat(Nfine),kmixdat(Nfine)
114      real :: kmix_z(nlay)   ! kmix from kmix_proffix
115
116!     variable added for N2 condensation:
117!     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
118      REAL hh , zhcond(ngrid,nlay)
119!      REAL latcond,tcond1p4Pa
120      REAL tcond1p4Pa
121      REAL acond,bcond
122      SAVE acond,bcond
123!      DATA latcond,tcond1p4Pa/2.5e5,38/
124      DATA tcond1p4Pa/38/
125
126!    Tracers :
127!    ~~~~~~~
128      INTEGER iq
129      REAL zq(ngrid,nlay,nq)
130      REAL zq1temp_co(ngrid)
131      REAL rho(ngrid) ! near surface air density
132      DATA firstcall/.true./
133
134!    ** un petit test de coherence
135!       --------------------------
136
137      IF (firstcall) THEN
138         IF(ngrid.NE.ngrid) THEN
139            write(*,*) 'STOP dans vdifc'
140            write(*,*) 'probleme de dimensions :'
141            write(*,*) 'ngrid  =',ngrid
142            write(*,*) 'ngrid  =',ngrid
143            STOP
144         ENDIF
145!        To compute: Tcond= 1./(bcond-acond*log(.7143*p)) (p in pascal)
146         write(*,*) 'In vdifc: Tcond(P=1.4Pa)=',tcond1p4Pa,' Lcond=',lw_n2
147         bcond=1./tcond1p4Pa
148         acond=r/lw_n2
149         write(*,*) '          acond,bcond',acond,bcond
150
151        firstcall=.false.
152
153        ! If fixed profile of kmix
154        IF (kmix_proffix) then
155            file_path=trim(datadir)//'/gas_prop/kmix.txt'
156            open(114,file=file_path,form='formatted')
157            do ifine=1,Nfine
158              read(114,*) levdat(ifine), kmixdat(ifine)
159            enddo
160            close(114)
161        ENDIF
162      ENDIF
163
164!-----------------------------------------------------------------------
165!    1. initialisation
166!    -----------------
167
168      nlev=nlay+1
169
170!    ** calcul de rho*dz et dt*rho/dz=dt*rho**2 g/dp
171!       avec rho=p/RT=p/ (R Theta) (p/ps)**kappa
172!       ----------------------------------------
173
174      DO ilay=1,nlay
175         DO ig=1,ngrid
176            za(ig,ilay)=(pplev(ig,ilay)-pplev(ig,ilay+1))/g
177         ENDDO
178      ENDDO
179
180      zcst1=4.*g*ptimestep/(r*r)
181      DO ilev=2,nlev-1
182         DO ig=1,ngrid
183            zb0(ig,ilev)=pplev(ig,ilev)* &
184           (pplev(ig,1)/pplev(ig,ilev))**rcp / &
185           (ph(ig,ilev-1)+ph(ig,ilev))
186            zb0(ig,ilev)=zcst1*zb0(ig,ilev)*zb0(ig,ilev)/ &
187           (pplay(ig,ilev-1)-pplay(ig,ilev))
188!            write(300,*)'zb0',zb0(ig,ilev)
189         ENDDO
190      ENDDO
191      DO ig=1,ngrid
192                 zb0(ig,1)=ptimestep*pplev(ig,1)/(r*ptsrf(ig))
193      ENDDO
194
195!    ** diagnostique pour l'initialisation
196!       ----------------------------------
197
198!      IF(lecrit) THEN
199!         ig=ngrid/2+1
200!         write(*,*) 'Pression (mbar) ,altitude (km),u,v,theta, rho dz'
201!         DO ilay=1,nlay
202!            WRITE(*,'(6f11.5)') &
203!           .01*pplay(ig,ilay),.001*pzlay(ig,ilay), &
204!           pu(ig,ilay),pv(ig,ilay),ph(ig,ilay),za(ig,ilay)
205!         ENDDO
206!         write(*,*) 'Pression (mbar) ,altitude (km),zb'
207!         DO ilev=1,nlay
208!            WRITE(*,'(3f15.7)') &
209!           .01*pplev(ig,ilev),.001*pzlev(ig,ilev), &
210!           zb0(ig,ilev)
211!         ENDDO
212!      ENDIF
213
214!     Potential Condensation temperature:
215!     -----------------------------------
216
217        if (condensn2) then
218          DO ilev=1,nlay
219            DO ig=1,ngrid
220              zhcond(ig,ilev) = &
221       (1./(bcond-acond*log(.7143*pplay(ig,ilev))))/ppopsk(ig,ilev)
222            END DO
223          END DO
224        else
225          DO ilev=1,nlay
226            DO ig=1,ngrid
227              zhcond(ig,ilev) = 0.
228            END DO
229          END DO
230        end if
231
232
233!-----------------------------------------------------------------------
234!   2. ajout des tendances physiques
235!      -----------------------------
236
237      DO ilev=1,nlay
238         DO ig=1,ngrid
239            zt(ig,ilev)=pt(ig,ilev)+pdtfi(ig,ilev)*ptimestep
240            zu(ig,ilev)=pu(ig,ilev)+pdufi(ig,ilev)*ptimestep
241            zv(ig,ilev)=pv(ig,ilev)+pdvfi(ig,ilev)*ptimestep
242            zh(ig,ilev)=ph(ig,ilev)+pdhfi(ig,ilev)*ptimestep
243            zh(ig,ilev)=max(zh(ig,ilev),zhcond(ig,ilev))
244         ENDDO
245      ENDDO
246      if(tracer) then
247        DO iq =1, nq
248         DO ilev=1,nlay
249           DO ig=1,ngrid
250              zq(ig,ilev,iq)=pq(ig,ilev,iq)+pdqfi(ig,ilev,iq)*ptimestep
251           ENDDO
252         ENDDO
253        ENDDO
254      end if
255
256!-----------------------------------------------------------------------
257!   3. schema de turbulence
258!      --------------------
259
260!    ** source d'energie cinetique turbulente a la surface
261!       (condition aux limites du schema de diffusion turbulente
262!       dans la couche limite
263!       ---------------------
264      CALL vdif_cd( ngrid,nlay,pz0,g,pzlay,pu,pv,ptsrf,ph &
265                  ,zcdv_true,zcdh_true)
266      DO ig=1,ngrid
267        zu2=pu(ig,1)*pu(ig,1)+pv(ig,1)*pv(ig,1)
268        !TB16: GCM wind for flat hemisphere
269        IF (phisfi(ig).eq.0.) zu2=max(2.,zu2)
270
271        zcdv(ig)=zcdv_true(ig)*sqrt(zu2)
272        zcdh(ig)=zcdh_true(ig)*sqrt(zu2)
273      ENDDO
274
275!    ** schema de diffusion turbulente dans la couche limite
276!       ----------------------------------------------------
277
278        CALL vdif_kc(ngrid,nlay,ptimestep,g,pzlev,pzlay &
279                   ,pu,pv,ph,zcdv_true &
280                   ,pq2,zkv,zkh)
281
282
283!    Adding eddy mixing to mimic 3D general circulation in 1D
284!    RW FF 2010
285      if ((ngrid.eq.1)) then
286        !kmixmin is the minimum eddy mix coeff in 1D
287
288        ! If fixed profile of kmix
289        IF (kmix_proffix) then
290            !! Interpolate on the model vertical grid
291            CALL interp_line(levdat,kmixdat,Nfine,&
292                       pzlay(1,:)/1000.,kmix_z(:),nlay)
293
294            do ilev=1,nlay
295               zkh(1,ilev) = max(kmix_z(ilev),zkh(1,ilev))
296               zkv(1,ilev) = max(kmix_z(ilev),zkv(1,ilev))
297               !zkh(1,ilev) = kmixmin
298               !zkv(1,ilev) = kmixmin
299            end do
300        ELSE
301            do ilev=1,nlay
302               zkh(1,ilev) = max(kmixmin,zkh(1,ilev))
303               zkv(1,ilev) = max(kmixmin,zkv(1,ilev))
304               !zkh(1,ilev) = kmixmin
305               !zkv(1,ilev) = kmixmin
306            end do
307        ENDIF
308      endif ! ngrid.eq.1
309
310!!    Temporary:
311!      zkh = zkh*0.1
312!      zkv = zkv*0.1
313
314!    ** diagnostique pour le schema de turbulence
315!       -----------------------------------------
316
317!      IF(lecrit) THEN
318!         write(*,*) !         write(*,*) 'Diagnostic for the vertical turbulent mixing'
319!         write(*,*) 'Cd for momentum and potential temperature'
320
321!         write(*,*) zcdv(ngrid/2+1),zcdh(ngrid/2+1)
322!         write(*,*) 'Mixing coefficient for momentum and pot.temp.'
323!         DO ilev=1,nlay
324!            write(*,*) zkv(ngrid/2+1,ilev),zkh(ngrid/2+1,ilev)
325!         ENDDO
326!      ENDIF
327
328!-----------------------------------------------------------------------
329!   4. inversion pour l'implicite sur u
330!      --------------------------------
331
332!    ** l'equation est
333!       u(t+1) =  u(t) + dt * {(du/dt)phys}(t)  +  dt * {(du/dt)difv}(t+1)
334!       avec
335!       /zu/ = u(t) + dt * {(du/dt)phys}(t)   (voir paragraphe 2.)
336!       et
337!       dt * {(du/dt)difv}(t+1) = dt * {(d/dz)[ Ku (du/dz) ]}(t+1)
338!       donc les entrees sont /zcdv/ pour la condition a la limite sol
339!       et /zkv/ = Ku
340
341      CALL multipl((nlay-1)*ngrid,zkv(1,2),zb0(1,2),zb(1,2))
342      CALL multipl(ngrid,zcdv,zb0,zb)
343
344      DO ig=1,ngrid
345         z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
346         zc(ig,nlay)=za(ig,nlay)*zu(ig,nlay)*z1(ig)
347         zd(ig,nlay)=zb(ig,nlay)*z1(ig)
348      ENDDO
349
350      DO ilay=nlay-1,1,-1
351         DO ig=1,ngrid
352            z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+   &
353              zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
354            zc(ig,ilay)=(za(ig,ilay)*zu(ig,ilay)+ &
355              zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
356            zd(ig,ilay)=zb(ig,ilay)*z1(ig)
357         ENDDO
358      ENDDO
359
360      DO ig=1,ngrid
361         zu(ig,1)=zc(ig,1)
362      ENDDO
363      DO ilay=2,nlay
364         DO ig=1,ngrid
365            zu(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*zu(ig,ilay-1)
366         ENDDO
367      ENDDO
368
369!-----------------------------------------------------------------------
370!   5. inversion pour l'implicite sur v
371!      --------------------------------
372
373!    ** l'equation est
374!       v(t+1) =  v(t) + dt * {(dv/dt)phys}(t)  +  dt * {(dv/dt)difv}(t+1)
375!       avec
376!       /zv/ = v(t) + dt * {(dv/dt)phys}(t)   (voir paragraphe 2.)
377!       et
378!       dt * {(dv/dt)difv}(t+1) = dt * {(d/dz)[ Kv (dv/dz) ]}(t+1)
379!       donc les entrees sont /zcdv/ pour la condition a la limite sol
380!       et /zkv/ = Kv
381
382      DO ig=1,ngrid
383         z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
384         zc(ig,nlay)=za(ig,nlay)*zv(ig,nlay)*z1(ig)
385         zd(ig,nlay)=zb(ig,nlay)*z1(ig)
386      ENDDO
387
388      DO ilay=nlay-1,1,-1
389         DO ig=1,ngrid
390            z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+ &
391              zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
392            zc(ig,ilay)=(za(ig,ilay)*zv(ig,ilay)+   &
393              zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
394            zd(ig,ilay)=zb(ig,ilay)*z1(ig)
395         ENDDO
396      ENDDO
397
398      DO ig=1,ngrid
399         zv(ig,1)=zc(ig,1)
400      ENDDO
401      DO ilay=2,nlay
402         DO ig=1,ngrid
403            zv(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*zv(ig,ilay-1)
404         ENDDO
405      ENDDO
406
407!-----------------------------------------------------------------------
408!   6. inversion pour l'implicite sur h sans oublier le couplage
409!      avec le sol (conduction)
410!      ------------------------
411
412!    ** l'equation est
413!       h(t+1) =  h(t) + dt * {(dh/dt)phys}(t)  +  dt * {(dh/dt)difv}(t+1)
414!       avec
415!       /zh/ = h(t) + dt * {(dh/dt)phys}(t)   (voir paragraphe 2.)
416!       et
417!       dt * {(dh/dt)difv}(t+1) = dt * {(d/dz)[ Kh (dh/dz) ]}(t+1)
418!       donc les entrees sont /zcdh/ pour la condition de raccord au sol
419!       et /zkh/ = Kh
420!       -------------
421
422      CALL multipl((nlay-1)*ngrid,zkh(1,2),zb0(1,2),zb(1,2))
423      CALL multipl(ngrid,zcdh,zb0,zb)
424
425      DO ig=1,ngrid
426         z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
427         zc(ig,nlay)=za(ig,nlay)*zh(ig,nlay)*z1(ig)
428         zd(ig,nlay)=zb(ig,nlay)*z1(ig)
429      ENDDO
430
431      DO ilay=nlay-1,1,-1
432         DO ig=1,ngrid
433            z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+ &
434              zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
435            zc(ig,ilay)=(za(ig,ilay)*zh(ig,ilay)+   &
436              zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
437            zd(ig,ilay)=zb(ig,ilay)*z1(ig)
438         ENDDO
439      ENDDO
440
441!    ** calcul de (d Planck / dT) a la temperature d'interface
442!       ------------------------------------------------------
443
444      z4st=4.*5.67e-8*ptimestep
445      DO ig=1,ngrid
446         zdplanck(ig)=z4st*pemis(ig)*ptsrf(ig)*ptsrf(ig)*ptsrf(ig)
447      ENDDO
448
449!    ** calcul de la temperature_d'interface et de sa tendance.
450!       on ecrit que la somme des flux est nulle a l'interface
451!       a t + \delta t,
452!       !'est a dire le flux radiatif a {t + \delta t}
453!       + le flux turbulent a {t + \delta t} &
454!            qui 'ecrit K (T1-Tsurf) avec T1 = d1 Tsurf + c1
455!            (notation K dt = /cpp*b/)
456!       + le flux dans le sol a t
457!       + l'evolution du flux dans le sol lorsque la temperature d'interface
458!       passe de sa valeur a t a sa valeur a {t + \delta t}.
459!       ----------------------------------------------------
460
461      DO ig=1,ngrid
462         z1(ig)=pcapcal(ig)*ptsrf(ig)+cpp*zb(ig,1)*zc(ig,1) &
463          +zdplanck(ig)*ptsrf(ig)+ pfluxsrf(ig)*ptimestep
464         z2(ig)= pcapcal(ig)+cpp*zb(ig,1)*(1.-zd(ig,1))+zdplanck(ig)
465         ztsrf2(ig)=z1(ig)/z2(ig)
466         pdtsrf(ig)=(ztsrf2(ig)-ptsrf(ig))/ptimestep
467
468!        Modif speciale N2 condensation:
469!        tconds = 1./(bcond-acond*log(.7143*pplev(ig,1)))
470!        if ((condensn2).and. &
471!          ((n2ice(ig).ne.0).or.(ztsrf2(ig).lt.tconds)))then
472!           zh(ig,1)=zc(ig,1)+zd(ig,1)*tconds
473!        else
474            zh(ig,1)=zc(ig,1)+zd(ig,1)*ztsrf2(ig)
475!        end if
476      ENDDO
477
478!    ** et a partir de la temperature au sol on remonte
479!       -----------------------------------------------
480
481      DO ilay=2,nlay
482         DO ig=1,ngrid
483            hh = max( zh(ig,ilay-1) , zhcond(ig,ilay-1) ) ! modif n2cond
484            zh(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*hh
485         ENDDO
486      ENDDO
487
488
489!-----------------------------------------------------------------------
490!   TRACERS
491!   -------
492
493      if(tracer) then
494
495!     Using the wind modified by friction for lifting and  sublimation
496!     ----------------------------------------------------------------
497!     This is computed above
498
499!        DO ig=1,ngrid
500!          zu2=zu(ig,1)*zu(ig,1)+zv(ig,1)*zv(ig,1)
501!          zcdv(ig)=zcdv_true(ig)*sqrt(zu2)
502!          zcdh(ig)=zcdh_true(ig)*sqrt(zu2)
503!        ENDDO
504
505!       Calcul flux vertical au bas de la premiere couche (cf dust on Mars)
506!       -----------------------------------------------------------
507        do ig=1,ngrid
508          rho(ig) = zb0(ig,1) /ptimestep
509!          zb(ig,1) = 0.
510        end do
511
512        pdqsdif(:,:) = 0
513        pdqdif(:,:,:)=0.
514
515
516!     TB: Eddy lifting of tracers :
517! ****************************************************************
518!        DO ig=1,ngrid
519!!          option : injection only on an equatorial band
520!!          if (abs(lati(ig))*180./pi.le.25.) then
521!            pdqsdif(ig,igcm_eddy1e6) =-1.e-12
522!           pdqsdif(ig,igcm_eddy1e7) =-1.e-12
523!            pdqsdif(ig,igcm_eddy5e7) =-1.e-12
524!            pdqsdif(ig,igcm_eddy1e8) =-1.e-12
525!            pdqsdif(ig,igcm_eddy5e8) =-1.e-12
526!          endif
527!        ENDDO
528
529!        pdqdifeddy(:,:,:)=0.
530!       injection a 50 km
531!        DO ig=1,ngrid
532!            pdqdifeddy(ig,17,igcm_eddy1e6)=1e-12
533!            pdqdifeddy(ig,17,igcm_eddy1e7)=1e-12
534!            pdqdifeddy(ig,17,igcm_eddy5e7)=1e-12
535!            pdqdifeddy(ig,17,igcm_eddy1e8)=1e-12
536!            pdqdifeddy(ig,17,igcm_eddy5e8)=1e-12
537!        ENDDO
538
539!      Inversion pour l'implicite sur q
540!       --------------------------------
541        do iq=1,nq
542          CALL multipl((nlay-1)*ngrid,zkh(1,2),zb0(1,2),zb(1,2))
543
544          if ((methane).and.(iq.eq.igcm_ch4_gas)) then
545!            This line is required to account for turbulent transport
546!            from surface (e.g. ice) to mid-layer of atmosphere:
547             CALL multipl(ngrid,zcdv,zb0,zb(1,1))
548          else if ((carbox).and.(iq.eq.igcm_co_gas)) then
549             CALL multipl(ngrid,zcdv,zb0,zb(1,1))
550          else ! (re)-initialize zb(:,1)
551             zb(1:ngrid,1)=0
552          end if
553
554          DO ig=1,ngrid
555               z1(ig)=1./(za(ig,nlay)+zb(ig,nlay))
556               zc(ig,nlay)=za(ig,nlay)*zq(ig,nlay,iq)*z1(ig)
557               zd(ig,nlay)=zb(ig,nlay)*z1(ig)
558          ENDDO
559
560          DO ilay=nlay-1,2,-1
561               DO ig=1,ngrid
562                z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+ &
563                zb(ig,ilay+1)*(1.-zd(ig,ilay+1)))
564                zc(ig,ilay)=(za(ig,ilay)*zq(ig,ilay,iq)+    &
565                zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig)
566                zd(ig,ilay)=zb(ig,ilay)*z1(ig)
567               ENDDO
568          ENDDO
569
570            ! special case for methane and CO ice tracer: do not include
571            ! ice tracer from surface (which is set when handling
572            ! vapour case (see further down).
573          if (methane.and.(iq.eq.igcm_ch4_ice)) then
574            DO ig=1,ngrid
575                z1(ig)=1./(za(ig,1)+zb(ig,1)+   &
576                 zb(ig,2)*(1.-zd(ig,2)))
577                zc(ig,1)=(za(ig,1)*zq(ig,1,iq)+ &
578                 zb(ig,2)*zc(ig,2)) *z1(ig)
579            ENDDO
580          else if (carbox.and.(iq.eq.igcm_co_ice)) then
581            DO ig=1,ngrid
582                z1(ig)=1./(za(ig,1)+zb(ig,1)+   &
583                 zb(ig,2)*(1.-zd(ig,2)))
584                zc(ig,1)=(za(ig,1)*zq(ig,1,iq)+ &
585                 zb(ig,2)*zc(ig,2)) *z1(ig)
586            ENDDO
587
588          else ! general case
589            DO ig=1,ngrid
590               z1(ig)=1./(za(ig,1)+zb(ig,1)+    &
591              zb(ig,2)*(1.-zd(ig,2)))
592               zc(ig,1)=(za(ig,1)*zq(ig,1,iq)+  &
593              zb(ig,2)*zc(ig,2) +   &
594             (-pdqsdif(ig,iq)) *ptimestep) *z1(ig)  !tracer flux from surface
595            ENDDO
596          endif ! of if (methane.and.(iq.eq.igcm_ch4_ice))
597
598!           Calculation for turbulent exchange with the surface (for ice)
599          IF (methane.and.(iq.eq.igcm_ch4_gas)) then
600
601            !! calcul de la valeur de q a la surface  :
602            call methanesat(ngrid,ptsrf,pplev(1,1),   &
603                                        qsat_ch4(:),pqsurf(:,igcm_n2))
604
605            !! For output:
606            call methanesat(ngrid,zt(:,1),pplev(1,1), &
607                                      qsat_ch4_l1(:),pqsurf(:,igcm_n2))
608
609            !! Prevent CH4 condensation at the surface
610            if (.not.condmetsurf) then
611               qsat_ch4=qsat_ch4*1.e6
612            endif
613
614            DO ig=1,ngrid
615              zd(ig,1)=zb(ig,1)*z1(ig)
616              zq1temp_ch4(ig)=zc(ig,1)+ zd(ig,1)*qsat_ch4(ig)
617              pdqsdif(ig,igcm_ch4_ice)=rho(ig)*zcdv(ig) &
618                            *(zq1temp_ch4(ig)-qsat_ch4(ig))
619            END DO
620
621            DO ig=1,ngrid
622                if ((-pdqsdif(ig,igcm_ch4_ice)*ptimestep) &
623                  .gt.(pqsurf(ig,igcm_ch4_ice))) then
624
625                  pdqsdif(ig,igcm_ch4_ice)= &
626                              -pqsurf(ig,igcm_ch4_ice)/ptimestep
627
628                  z1(ig)=1./(za(ig,1)+ zb(ig,2)*(1.-zd(ig,2)))
629
630                  zc(ig,1)=(za(ig,1)*zq(ig,1,igcm_ch4_gas)+ &
631                 zb(ig,2)*zc(ig,2) +    &
632                 (-pdqsdif(ig,igcm_ch4_ice)) *ptimestep) *z1(ig)
633
634                  zq1temp_ch4(ig)=zc(ig,1)
635                endif
636
637             zq(ig,1,igcm_ch4_gas)=zq1temp_ch4(ig)
638
639!            TB: MODIF speciale  pour  CH4
640             pdtsrf(ig)=pdtsrf(ig)+ &
641             lw_ch4*pdqsdif(ig,igcm_ch4_ice)/pcapcal(ig)
642
643
644            ENDDO ! of DO ig=1,ngrid
645
646          ELSE IF (carbox.and.(iq.eq.igcm_co_gas)) then
647
648           ! calcul de la valeur de q a la surface :
649            call cosat(ngrid,ptsrf,pplev(1,1),qsat_co, &
650                   pqsurf(:,igcm_n2),pqsurf(:,igcm_ch4_ice))
651
652            !! Prevent CO condensation at the surface
653            if (.not.condcosurf) then
654               qsat_co=qsat_co*1.e6
655            endif
656
657            DO ig=1,ngrid
658              zd(ig,1)=zb(ig,1)*z1(ig)
659              zq1temp_co(ig)=zc(ig,1)+ zd(ig,1)*qsat_co(ig)
660              pdqsdif(ig,igcm_co_ice)=rho(ig)*zcdv(ig) &
661                            *(zq1temp_co(ig)-qsat_co(ig))
662            END DO
663
664
665            DO ig=1,ngrid
666!   -------------------------------------------------------------
667!           TEMPORAIRE : pour initialiser CO si glacier N2
668!               meme si il n'y a pas de CO disponible
669!             if (pqsurf(ig,igcm_n2).le.10.) then
670!   -------------------------------------------------------------
671!
672                if ((-pdqsdif(ig,igcm_co_ice)*ptimestep) &
673                  .gt.(pqsurf(ig,igcm_co_ice))) then
674                  pdqsdif(ig,igcm_co_ice)= &
675                              -pqsurf(ig,igcm_co_ice)/ptimestep
676                  z1(ig)=1./(za(ig,1)+ zb(ig,2)*(1.-zd(ig,2)))
677                  zc(ig,1)=(za(ig,1)*zq(ig,1,igcm_co_gas)+  &
678                 zb(ig,2)*zc(ig,2) +    &
679                 (-pdqsdif(ig,igcm_co_ice)) *ptimestep) *z1(ig)
680                  zq1temp_co(ig)=zc(ig,1)
681                endif
682!             endif
683
684               zq(ig,1,igcm_co_gas)=zq1temp_co(ig)
685
686!            MODIF speciale  pour  CO / corrected by FF 2016
687             pdtsrf(ig)=pdtsrf(ig)+ &
688             lw_co*pdqsdif(ig,igcm_co_ice)/pcapcal(ig)
689
690            ENDDO ! of DO ig=1,ngrid
691
692          ELSE ! if (methane)
693
694            DO ig=1,ngrid
695               zq(ig,1,iq)=zc(ig,1)
696            ENDDO
697
698          END IF ! of IF ((methane).and.(iq.eq.igcm_ch4_vap))
699
700          !! Diffusion verticale : shut down vertical transport of vertdiff = false
701          if (vertdiff) then
702           DO ilay=2,nlay
703             DO ig=1,ngrid
704                zq(ig,ilay,iq)=zc(ig,ilay)+zd(ig,ilay)*zq(ig,ilay-1,iq)
705            ENDDO
706           ENDDO
707          endif
708
709        enddo ! of do iq=1,nq
710      end if ! of if(tracer)
711
712!-----------------------------------------------------------------------
713!   8. calcul final des tendances de la diffusion verticale
714!      ----------------------------------------------------
715      DO ilev = 1, nlay
716         DO ig=1,ngrid
717            pdudif(ig,ilev)=(    zu(ig,ilev)-   &
718           (pu(ig,ilev)+pdufi(ig,ilev)*ptimestep)    )/ptimestep
719            pdvdif(ig,ilev)=(    zv(ig,ilev)-   &
720           (pv(ig,ilev)+pdvfi(ig,ilev)*ptimestep)    )/ptimestep
721           hh = max(ph(ig,ilev)+pdhfi(ig,ilev)*ptimestep ,  &
722                zhcond(ig,ilev))        ! modif n2cond
723            pdhdif(ig,ilev)=( zh(ig,ilev)- hh )/ptimestep
724         ENDDO
725      ENDDO
726
727      if (tracer) then
728        DO iq = 1, nq
729          DO ilev = 1, nlay
730            DO ig=1,ngrid
731              pdqdif(ig,ilev,iq)=(zq(ig,ilev,iq)-   &
732           (pq(ig,ilev,iq) + pdqfi(ig,ilev,iq)*ptimestep))/ptimestep
733!             pdqdif(ig,ilev,iq)=pdqdifeddy(ig,ilev,iq)+(zq(ig,ilev,iq)-    &
734!           (pq(ig,ilev,iq) + pdqfi(ig,ilev,iq)*ptimestep))/ptimestep
735            ENDDO
736         ENDDO
737        ENDDO
738      end if
739
740!    ** diagnostique final
741!       ------------------
742
743      IF(lecrit) THEN
744         write(*,*) 'In vdif'
745         write(*,*) 'Ts (t) and Ts (t+st)'
746         WRITE(*,'(a10,3a15)') &
747        'theta(t)','theta(t+dt)','u(t)','u(t+dt)'
748         write(*,*) ptsrf(ngrid/2+1),ztsrf2(ngrid/2+1)
749         DO ilev=1,nlay
750            WRITE(*,'(4f15.7)') &
751           ph(ngrid/2+1,ilev),zh(ngrid/2+1,ilev), &
752           pu(ngrid/2+1,ilev),zu(ngrid/2+1,ilev)
753
754         ENDDO
755      ENDIF
756
757      RETURN
758    !   END
759
760    end subroutine vdifc_pluto
761
762end module vdifc_pluto_mod
Note: See TracBrowser for help on using the repository browser.