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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 76 by guez, Fri Nov 15 18:45:49 2013 UTC revision 340 by guez, Thu Sep 26 17:29:50 2019 UTC
# Line 1  Line 1 
1    module dqthermcell_m
2    
3        subroutine dqthermcell(ngrid,nlay,ptimestep,fm,entr,masse &    implicit none
4            ,q,dq,qa)  
5        use dimens_m  contains
6        use dimphy  
7        implicit none    subroutine dqthermcell(ngrid,nlay,ptimestep,fm,entr,masse &
8           ,q,dq,qa)
9  !=======================================================================      use dimensions
10  !      use dimphy
11  !   Calcul du transport verticale dans la couche limite en presence  
12  !   de "thermiques" explicitement representes      !=======================================================================
13  !   calcul du dq/dt une fois qu'on connait les ascendances      !
14  !      !   Calcul du transport verticale dans la couche limite en presence
15  !=======================================================================      !   de "thermiques" explicitement representes
16        !   calcul du dq/dt une fois qu'on connait les ascendances
17        !
18        integer ngrid,nlay      !=======================================================================
19    
20        real ptimestep  
21        real, intent(in):: masse(ngrid,nlay)      integer ngrid,nlay
22        real fm(ngrid,nlay+1)  
23        real entr(ngrid,nlay)      real ptimestep
24        real q(ngrid,nlay)      real, intent(in):: masse(ngrid,nlay)
25        real dq(ngrid,nlay)      real fm(ngrid,nlay+1)
26        real entr(ngrid,nlay)
27        real qa(klon,klev),detr(klon,klev),wqd(klon,klev+1)      real q(ngrid,nlay)
28        real dq(ngrid,nlay)
29        integer ig,k  
30        real qa(klon,klev),detr(klon,klev),wqd(klon,klev+1)
31  !   calcul du detrainement  
32        integer ig,k
33        do k=1,nlay  
34           do ig=1,ngrid      !   calcul du detrainement
35              detr(ig,k)=fm(ig,k)-fm(ig,k+1)+entr(ig,k)  
36           enddo      do k=1,nlay
37        enddo         do ig=1,ngrid
38              detr(ig,k)=fm(ig,k)-fm(ig,k+1)+entr(ig,k)
39  !   calcul de la valeur dans les ascendances         enddo
40        do ig=1,ngrid      enddo
41           qa(ig,1)=q(ig,1)  
42        enddo      !   calcul de la valeur dans les ascendances
43        do ig=1,ngrid
44        do k=2,nlay         qa(ig,1)=q(ig,1)
45           do ig=1,ngrid      enddo
46              if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt. &  
47        do k=2,nlay
48           do ig=1,ngrid
49              if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt. &
50                 1.e-5*masse(ig,k)) then                 1.e-5*masse(ig,k)) then
51                 qa(ig,k)=(fm(ig,k)*qa(ig,k-1)+entr(ig,k)*q(ig,k)) &               qa(ig,k)=(fm(ig,k)*qa(ig,k-1)+entr(ig,k)*q(ig,k)) &
52                 /(fm(ig,k+1)+detr(ig,k))                    /(fm(ig,k+1)+detr(ig,k))
53              else            else
54                 qa(ig,k)=q(ig,k)               qa(ig,k)=q(ig,k)
55              endif            endif
56           enddo         enddo
57        enddo      enddo
58    
59        do k=2,nlay      do k=2,nlay
60           do ig=1,ngrid         do ig=1,ngrid
61  !             wqd(ig,k)=fm(ig,k)*0.5*(q(ig,k-1)+q(ig,k))            !             wqd(ig,k)=fm(ig,k)*0.5*(q(ig,k-1)+q(ig,k))
62              wqd(ig,k)=fm(ig,k)*q(ig,k)            wqd(ig,k)=fm(ig,k)*q(ig,k)
63           enddo         enddo
64        enddo      enddo
65        do ig=1,ngrid      do ig=1,ngrid
66           wqd(ig,1)=0.         wqd(ig,1)=0.
67           wqd(ig,nlay+1)=0.         wqd(ig,nlay+1)=0.
68        enddo      enddo
69    
70        do k=1,nlay      do k=1,nlay
71           do ig=1,ngrid         do ig=1,ngrid
72              dq(ig,k)=(detr(ig,k)*qa(ig,k)-entr(ig,k)*q(ig,k) &            dq(ig,k)=(detr(ig,k)*qa(ig,k)-entr(ig,k)*q(ig,k) &
73                       -wqd(ig,k)+wqd(ig,k+1)) &                 -wqd(ig,k)+wqd(ig,k+1)) &
74                       /masse(ig,k)                 /masse(ig,k)
75           enddo         enddo
76        enddo      enddo
77    
78      end subroutine dqthermcell
79    
80        return  end module dqthermcell_m
       end  
Legend:
Removed from v.76  
changed lines
  Added in v.340
  ViewVC Help
Powered by ViewVC 1.1.21