/[lmdze]/trunk/phylmd/Thermcell/dqthermcell.f90
ViewVC logotype

Annotation of /trunk/phylmd/Thermcell/dqthermcell.f90

Parent Directory Parent Directory | Revision Log Revision Log


Revision 76 - (hide annotations)
Fri Nov 15 18:45:49 2013 UTC (10 years, 6 months ago) by guez
File size: 1821 byte(s)
Moved everything out of libf.
1 guez 47
2     subroutine dqthermcell(ngrid,nlay,ptimestep,fm,entr,masse &
3     ,q,dq,qa)
4     use dimens_m
5     use dimphy
6     implicit none
7    
8     !=======================================================================
9     !
10     ! Calcul du transport verticale dans la couche limite en presence
11     ! de "thermiques" explicitement representes
12     ! calcul du dq/dt une fois qu'on connait les ascendances
13     !
14     !=======================================================================
15    
16    
17     integer ngrid,nlay
18    
19     real ptimestep
20     real, intent(in):: masse(ngrid,nlay)
21     real fm(ngrid,nlay+1)
22     real entr(ngrid,nlay)
23     real q(ngrid,nlay)
24     real dq(ngrid,nlay)
25    
26     real qa(klon,klev),detr(klon,klev),wqd(klon,klev+1)
27    
28     integer ig,k
29    
30     ! calcul du detrainement
31    
32     do k=1,nlay
33     do ig=1,ngrid
34     detr(ig,k)=fm(ig,k)-fm(ig,k+1)+entr(ig,k)
35     enddo
36     enddo
37    
38     ! calcul de la valeur dans les ascendances
39     do ig=1,ngrid
40     qa(ig,1)=q(ig,1)
41     enddo
42    
43     do k=2,nlay
44     do ig=1,ngrid
45     if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt. &
46     1.e-5*masse(ig,k)) then
47     qa(ig,k)=(fm(ig,k)*qa(ig,k-1)+entr(ig,k)*q(ig,k)) &
48     /(fm(ig,k+1)+detr(ig,k))
49     else
50     qa(ig,k)=q(ig,k)
51     endif
52     enddo
53     enddo
54    
55     do k=2,nlay
56     do ig=1,ngrid
57     ! wqd(ig,k)=fm(ig,k)*0.5*(q(ig,k-1)+q(ig,k))
58     wqd(ig,k)=fm(ig,k)*q(ig,k)
59     enddo
60     enddo
61     do ig=1,ngrid
62     wqd(ig,1)=0.
63     wqd(ig,nlay+1)=0.
64     enddo
65    
66     do k=1,nlay
67     do ig=1,ngrid
68     dq(ig,k)=(detr(ig,k)*qa(ig,k)-entr(ig,k)*q(ig,k) &
69     -wqd(ig,k)+wqd(ig,k+1)) &
70     /masse(ig,k)
71     enddo
72     enddo
73    
74     return
75     end

  ViewVC Help
Powered by ViewVC 1.1.21