/[lmdze]/trunk/libf/phylmd/calltherm.f90
ViewVC logotype

Diff of /trunk/libf/phylmd/calltherm.f90

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

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