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

Diff of /trunk/Sources/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/libf/phylmd/calltherm.f90 revision 54 by guez, Tue Dec 6 15:07:04 2011 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    
12        USE dimphy, ONLY: klev, klon
13        USE ctherm, ONLY: l_mix_thermals, nsplit_thermals, r_aspect_thermals, &
14             tho_thermals, w2di_thermals
15        use thermcell_m, only: thermcell
16    
17        REAL, intent(in):: dtime
18    
19        REAL u_seri(klon, klev), v_seri(klon, klev)
20        REAL, intent(inout):: t_seri(klon, klev)
21        real q_seri(klon, klev)
22        REAL, intent(in):: paprs(klon, klev+1)
23        REAL, intent(in):: pplay(klon, klev)
24        REAL, intent(in):: pphi(klon, klev)
25    
26        ! Update thermiques
27        REAL d_t_ajs(klon, klev), d_q_ajs(klon, klev)
28        REAL d_u_ajs(klon, klev), d_v_ajs(klon, klev)
29        real fm_therm(klon, klev+1), entr_therm(klon, klev)
30    
31        ! Variables locales
32        REAL d_t_the(klon, klev), d_q_the(klon, klev)
33        REAL d_u_the(klon, klev), d_v_the(klon, klev)
34        !
35        real, save:: zfm_therm(klon, klev+1), zentr_therm(klon, klev)
36        real zdt
37    
38        integer i, k, isplit
39    
40        !----------------------------------------------------------------
41    
42        ! Modele du thermique
43        print*, 'avant isplit ', nsplit_thermals
44    
45        fm_therm=0.
46        entr_therm=0.
47    
48        ! tests sur les valeurs negatives de l'eau
49        do k=1, klev
50           do i=1, klon
51              if (.not.q_seri(i, k).ge.0.) then
52                 print*, 'WARN eau<0 avant therm i=', i, ' k=', k, ' dq, q', &
53                      d_q_the(i, k), q_seri(i, k)
54                 q_seri(i, k)=1.e-15
55              endif
56           enddo
57        enddo
58    
59        zdt=dtime/float(nsplit_thermals)
60        do isplit = 1, nsplit_thermals
61           CALL thermcell(klon, klev, zdt, pplay, paprs, pphi, u_seri, v_seri, &
62                t_seri, q_seri, d_u_the, d_v_the, d_t_the, d_q_the, zfm_therm, &
63                zentr_therm, r_aspect_thermals, l_mix_thermals, w2di_thermals, &
64                tho_thermals)
65    
66           ! transformation de la derivee en tendance
67           d_t_the=d_t_the*dtime/float(nsplit_thermals)
68           d_u_the=d_u_the*dtime/float(nsplit_thermals)
69           d_v_the=d_v_the*dtime/float(nsplit_thermals)
70           d_q_the=d_q_the*dtime/float(nsplit_thermals)
71           fm_therm=fm_therm +zfm_therm/float(nsplit_thermals)
72           entr_therm=entr_therm +zentr_therm/float(nsplit_thermals)
73           fm_therm(:, klev+1)=0.
74    
75           ! accumulation de la tendance
76           d_t_ajs=d_t_ajs+d_t_the
77           d_u_ajs=d_u_ajs+d_u_the
78           d_v_ajs=d_v_ajs+d_v_the
79           d_q_ajs=d_q_ajs+d_q_the
80    
81           ! incrementation des variables meteo
82           t_seri = t_seri + d_t_the
83           u_seri = u_seri + d_u_the
84           v_seri = v_seri + d_v_the
85           q_seri = q_seri + d_q_the
86    
87           ! tests sur les valeurs negatives de l'eau
88           DO k = 1, klev
89              DO i = 1, klon
90                 if (.not.q_seri(i, k).ge.0.) then
91                    print*, 'WARN eau<0 apres therm i=', i, ' k=', k, ' dq, q', &
92                         d_q_the(i, k), q_seri(i, k)
93                    q_seri(i, k)=1.e-15
94                 endif
95              ENDDO
96           ENDDO
97        enddo
98    
99      end subroutine calltherm
100    
101    end module calltherm_m
Legend:
Removed from v.3  
changed lines
  Added in v.54
  ViewVC Help
Powered by ViewVC 1.1.21