/[lmdze]/trunk/phylmd/calltherm.f
ViewVC logotype

Diff of /trunk/phylmd/calltherm.f

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

trunk/libf/phylmd/calltherm.f revision 3 by guez, Wed Feb 27 13:16:39 2008 UTC trunk/Sources/phylmd/calltherm.f revision 208 by guez, Wed Dec 7 16:44:53 2016 UTC
# Line 1  Line 1 
1  !  module calltherm_m
 ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/calltherm.F,v 1.2 2004/12/10 11:27:46 lmdzadmin Exp $  
 !  
       subroutine calltherm(dtime  
      s      ,pplay,paprs,pphi  
      s      ,u_seri,v_seri,t_seri,q_seri  
      s      ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs  
      s      ,fm_therm,entr_therm)  
   
       use dimens_m  
       use dimphy  
       use ctherm  
       implicit none  
   
       REAL dtime  
   
       REAL u_seri(klon,klev),v_seri(klon,klev)  
       REAL t_seri(klon,klev),q_seri(klon,klev)  
       REAL, intent(in):: paprs(klon,klev+1)  
       REAL pplay(klon,klev)  
       REAL pphi(klon,klev)  
   
 CFH Update Thermiques  
       REAL d_t_ajs(klon,klev), d_q_ajs(klon,klev)  
       REAL d_u_ajs(klon,klev),d_v_ajs(klon,klev)  
       real fm_therm(klon,klev+1),entr_therm(klon,klev)  
   
   
 c variables locales  
       REAL d_t_the(klon,klev), d_q_the(klon,klev)  
       REAL d_u_the(klon,klev),d_v_the(klon,klev)  
 c  
       real zfm_therm(klon,klev+1),zentr_therm(klon,klev),zdt  
       save zentr_therm,zfm_therm  
   
       integer i,k, isplit  
   
 *********************************************************  
   
 c  Modele du thermique  
 c  ===================  
 c         print*,'thermiques: WARNING on passe t au lieu de t_seri'  
        print*,'avant isplit ',nsplit_thermals  
   
   
          fm_therm(:,:)=0.  
          entr_therm(:,:)=0.  
   
 c   tests sur les valeurs negatives de l'eau  
          do k=1,klev  
             do i=1,klon  
                if (.not.q_seri(i,k).ge.0.) then  
                    print*,'WARN eau<0 avant therm i=',i,'  k=',k  
      s         ,' dq,q',d_q_the(i,k),q_seri(i,k)  
                   q_seri(i,k)=1.e-15  
                endif  
             enddo  
          enddo  
   
   
          zdt=dtime/float(nsplit_thermals)  
          do isplit=1,nsplit_thermals  
   
 cym            CALL thermcell(klon,klev,zdt  
 cym     s      ,pplay,paprs,pphi  
 cym     s      ,u_seri,v_seri,t_seri,q_seri  
 cym     s      ,d_u_the,d_v_the,d_t_the,d_q_the  
 cym     s      ,zfm_therm,zentr_therm  
 cym     s      ,r_aspect_thermals,l_mix_thermals,w2di_thermals  
 cym     s      ,tho_thermals,3)  
   
             CALL thermcell(klon,klev,zdt  
      s      ,pplay,paprs,pphi  
      s      ,u_seri,v_seri,t_seri,q_seri  
      s      ,d_u_the,d_v_the,d_t_the,d_q_the  
      s      ,zfm_therm,zentr_therm  
      s      ,r_aspect_thermals,l_mix_thermals,w2di_thermals  
      s      ,tho_thermals)  
   
 c  transformation de la derivee en tendance  
             d_t_the(:,:)=d_t_the(:,:)*dtime/float(nsplit_thermals)  
             d_u_the(:,:)=d_u_the(:,:)*dtime/float(nsplit_thermals)  
             d_v_the(:,:)=d_v_the(:,:)*dtime/float(nsplit_thermals)  
             d_q_the(:,:)=d_q_the(:,:)*dtime/float(nsplit_thermals)  
             fm_therm(:,:)=fm_therm(:,:)  
      s      +zfm_therm(:,:)/float(nsplit_thermals)  
             entr_therm(:,:)=entr_therm(:,:)  
      s       +zentr_therm(:,:)/float(nsplit_thermals)  
             fm_therm(:,klev+1)=0.  
   
   
   
 c  accumulation de la tendance  
             d_t_ajs(:,:)=d_t_ajs(:,:)+d_t_the(:,:)  
             d_u_ajs(:,:)=d_u_ajs(:,:)+d_u_the(:,:)  
             d_v_ajs(:,:)=d_v_ajs(:,:)+d_v_the(:,:)  
             d_q_ajs(:,:)=d_q_ajs(:,:)+d_q_the(:,:)  
   
 c  incrementation des variables meteo  
             t_seri(:,:) = t_seri(:,:) + d_t_the(:,:)  
             u_seri(:,:) = u_seri(:,:) + d_u_the(:,:)  
             v_seri(:,:) = v_seri(:,:) + d_v_the(:,:)  
             q_seri(:,:) = q_seri(:,:) + d_q_the(:,:)  
   
 c   tests sur les valeurs negatives de l'eau  
             DO k = 1, klev  
             DO i = 1, klon  
                if (.not.q_seri(i,k).ge.0.) then  
                    print*,'WARN eau<0 apres therm i=',i,'  k=',k  
      s         ,' dq,q',d_q_the(i,k),q_seri(i,k)  
                   q_seri(i,k)=1.e-15  
                endif  
             ENDDO  
             ENDDO  
2    
3           enddo ! isplit    implicit none
4    
5        return  contains
6    
7        end    subroutine calltherm(dtime, pplay, paprs, pphi, u_seri, v_seri, t_seri, &
8           q_seri, d_u_ajs, d_v_ajs, d_t_ajs, d_q_ajs, fm_therm, entr_therm)
9    
10        ! From LMDZ4/libf/phylmd/calltherm.F, version 1.2 2004/12/10 11:27:46
11        ! Thermiques
12    
13        USE dimphy, ONLY: klev, klon
14        USE ctherm, ONLY: l_mix_thermals, nsplit_thermals, r_aspect_thermals, &
15             tho_thermals, w2di_thermals
16        use thermcell_m, only: thermcell
17    
18        REAL, intent(in):: dtime
19        REAL, intent(in):: pplay(klon, klev)
20        REAL, intent(in):: paprs(klon, klev+1)
21        REAL, intent(in):: pphi(klon, klev)
22        REAL, intent(inout):: u_seri(klon, klev), v_seri(klon, klev)
23        REAL, intent(inout):: t_seri(klon, klev)
24        real, intent(inout):: q_seri(klon, klev)
25    
26        ! Update thermiques
27        REAL d_u_ajs(klon, klev), d_v_ajs(klon, klev)
28        REAL d_t_ajs(klon, klev), d_q_ajs(klon, klev)
29        real fm_therm(klon, klev+1), entr_therm(klon, klev)
30    
31        ! Local:
32    
33        REAL d_t_the(klon, klev), d_q_the(klon, klev)
34        REAL d_u_the(klon, klev), d_v_the(klon, klev)
35    
36        real, save:: zfm_therm(klon, klev+1), zentr_therm(klon, klev)
37        real zdt
38    
39        integer i, k, isplit
40    
41        !----------------------------------------------------------------
42    
43        ! Modele du thermique
44        print*, 'avant isplit ', nsplit_thermals
45    
46        fm_therm=0.
47        entr_therm=0.
48    
49        ! tests sur les valeurs negatives de l'eau
50        do k=1, klev
51           do i=1, klon
52              if (.not.q_seri(i, k) >= 0.) then
53                 print*, 'WARN eau<0 avant therm i=', i, ' k=', k, ' dq, q', &
54                      d_q_the(i, k), q_seri(i, k)
55                 q_seri(i, k)=1.e-15
56              endif
57           enddo
58        enddo
59    
60        zdt=dtime/real(nsplit_thermals)
61        do isplit = 1, nsplit_thermals
62           CALL thermcell(klon, klev, zdt, pplay, paprs, pphi, u_seri, v_seri, &
63                t_seri, q_seri, d_u_the, d_v_the, d_t_the, d_q_the, zfm_therm, &
64                zentr_therm, r_aspect_thermals, l_mix_thermals, w2di_thermals, &
65                tho_thermals)
66    
67           ! transformation de la derivee en tendance
68           d_t_the=d_t_the*dtime/real(nsplit_thermals)
69           d_u_the=d_u_the*dtime/real(nsplit_thermals)
70           d_v_the=d_v_the*dtime/real(nsplit_thermals)
71           d_q_the=d_q_the*dtime/real(nsplit_thermals)
72           fm_therm=fm_therm +zfm_therm/real(nsplit_thermals)
73           entr_therm=entr_therm +zentr_therm/real(nsplit_thermals)
74           fm_therm(:, klev+1)=0.
75    
76           ! accumulation de la tendance
77           d_t_ajs=d_t_ajs+d_t_the
78           d_u_ajs=d_u_ajs+d_u_the
79           d_v_ajs=d_v_ajs+d_v_the
80           d_q_ajs=d_q_ajs+d_q_the
81    
82           ! incrementation des variables meteo
83           t_seri = t_seri + d_t_the
84           u_seri = u_seri + d_u_the
85           v_seri = v_seri + d_v_the
86           q_seri = q_seri + d_q_the
87    
88           ! tests sur les valeurs negatives de l'eau
89           DO k = 1, klev
90              DO i = 1, klon
91                 if (.not.q_seri(i, k) >= 0.) then
92                    print*, 'WARN eau<0 apres therm i=', i, ' k=', k, ' dq, q', &
93                         d_q_the(i, k), q_seri(i, k)
94                    q_seri(i, k)=1.e-15
95                 endif
96              ENDDO
97           ENDDO
98        enddo
99    
100      end subroutine calltherm
101    
102    end module calltherm_m

Legend:
Removed from v.3  
changed lines
  Added in v.208

  ViewVC Help
Powered by ViewVC 1.1.21