/[lmdze]/trunk/Sources/phylmd/CV30_routines/cv30_compress.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/CV30_routines/cv30_compress.f

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

trunk/libf/phylmd/CV3_routines/cv3_compress.f90 revision 52 by guez, Fri Sep 23 12:28:01 2011 UTC trunk/Sources/phylmd/CV30_routines/cv30_compress.f revision 195 by guez, Wed May 18 17:56:44 2016 UTC
# Line 1  Line 1 
1    module cv30_compress_m
2    
3        SUBROUTINE cv3_compress( len,nloc,ncum,nd,ntra &    implicit none
           ,iflag1,nk1,icb1,icbs1 &  
           ,plcl1,tnk1,qnk1,gznk1,pbase1,buoybase1 &  
           ,t1,q1,qs1,u1,v1,gz1,th1 &  
           ,tra1 &  
           ,h1,lv1,cpn1,p1,ph1,tv1,tp1,tvp1,clw1  &  
           ,sig1,w01 &  
           ,iflag,nk,icb,icbs &  
           ,plcl,tnk,qnk,gznk,pbase,buoybase &  
           ,t,q,qs,u,v,gz,th &  
           ,tra &  
           ,h,lv,cpn,p,ph,tv,tp,tvp,clw  &  
           ,sig,w0  )  
             use cvparam3  
       implicit none  
   
   
 ! inputs:  
       integer len,ncum,nd,ntra,nloc  
       integer iflag1(len),nk1(len),icb1(len),icbs1(len)  
       real plcl1(len),tnk1(len),qnk1(len),gznk1(len)  
       real pbase1(len),buoybase1(len)  
       real, intent(in):: t1(len,nd)  
       real q1(len,nd),qs1(len,nd),u1(len,nd),v1(len,nd)  
       real gz1(len,nd),h1(len,nd),lv1(len,nd),cpn1(len,nd)  
       real p1(len,nd),ph1(len,nd+1),tv1(len,nd),tp1(len,nd)  
       real tvp1(len,nd),clw1(len,nd)  
       real th1(len,nd)  
       real sig1(len,nd), w01(len,nd)  
       real, intent(in):: tra1(len,nd,ntra)  
   
 ! outputs:  
 ! en fait, on a nloc=len pour l'instant (cf cv_driver)  
       integer iflag(nloc),nk(nloc),icb(nloc),icbs(nloc)  
       real plcl(nloc),tnk(nloc),qnk(nloc),gznk(nloc)  
       real pbase(nloc),buoybase(nloc)  
       real t(nloc,nd),q(nloc,nd),qs(nloc,nd),u(nloc,nd),v(nloc,nd)  
       real gz(nloc,nd),h(nloc,nd),lv(nloc,nd),cpn(nloc,nd)  
       real p(nloc,nd),ph(nloc,nd+1),tv(nloc,nd),tp(nloc,nd)  
       real tvp(nloc,nd),clw(nloc,nd)  
       real th(nloc,nd)  
       real sig(nloc,nd), w0(nloc,nd)  
       real tra(nloc,nd,ntra)  
4    
5  ! local variables:  contains
       integer i,k,nn,j  
6    
7      SUBROUTINE cv30_compress(ncum, iflag1, nk1, icb1, icbs1, plcl1, tnk1, qnk1, &
8           gznk1, pbase1, buoybase1, t1, q1, qs1, u1, v1, gz1, th1, h1, lv1, cpn1, &
9           p1, ph1, tv1, tp1, tvp1, clw1, sig1, w01, iflag, nk, icb, icbs, plcl, &
10           tnk, qnk, gznk, pbase, buoybase, t, q, qs, u, v, gz, th, h, lv, cpn, p, &
11           ph, tv, tp, tvp, clw, sig, w0)
12    
13        ! Compress the fields (vectorization over convective gridpoints).
14    
15        use cv30_param_m, only: nl
16        USE dimphy, ONLY: klev, klon
17        use nr_util, only: assert
18    
19        ! inputs:
20        integer, intent(in):: ncum
21        integer, intent(in):: iflag1(klon), nk1(klon), icb1(klon), icbs1(klon)
22        real, intent(in):: plcl1(klon), tnk1(klon), qnk1(klon), gznk1(klon)
23        real pbase1(klon), buoybase1(klon)
24        real, intent(in):: t1(klon, klev)
25        real, intent(in):: q1(klon, klev), qs1(klon, klev)
26        real, intent(in):: u1(klon, klev), v1(klon, klev)
27        real gz1(klon, klev), h1(klon, klev), lv1(klon, klev), cpn1(klon, klev)
28        real, intent(in):: p1(klon, klev), ph1(klon, klev+1)
29        real, intent(in):: tv1(klon, klev), tp1(klon, klev)
30        real tvp1(klon, klev), clw1(klon, klev)
31        real th1(klon, klev)
32        real sig1(klon, klev), w01(klon, klev)
33    
34        ! outputs:
35        integer iflag(klon), nk(klon)
36        integer, intent(out):: icb(:) ! (ncum)
37        integer icbs(klon)
38        real plcl(klon), tnk(klon), qnk(klon), gznk(klon)
39        real pbase(klon), buoybase(klon)
40        real t(klon, klev), q(klon, klev), qs(klon, klev)
41        real u(klon, klev), v(klon, klev)
42        real gz(klon, klev), h(klon, klev), lv(klon, klev), cpn(klon, klev)
43        real p(klon, klev), ph(klon, klev+1), tv(klon, klev), tp(klon, klev)
44        real tvp(klon, klev), clw(klon, klev)
45        real th(klon, klev)
46        real sig(klon, klev), w0(klon, klev)
47    
48        do 110 k=1,nl+1      ! Local:
49        integer i, k, nn
50    
51        !---------------------------------------------------------------
52    
53        do k=1, nl+1
54         nn=0         nn=0
55        do 100 i=1,len         do i=1, klon
56        if(iflag1(i).eq.0)then            if (iflag1(i) == 0) then
57          nn=nn+1               nn=nn+1
58          sig(nn,k)=sig1(i,k)               sig(nn, k)=sig1(i, k)
59          w0(nn,k)=w01(i,k)               w0(nn, k)=w01(i, k)
60          t(nn,k)=t1(i,k)               t(nn, k)=t1(i, k)
61          q(nn,k)=q1(i,k)               q(nn, k)=q1(i, k)
62          qs(nn,k)=qs1(i,k)               qs(nn, k)=qs1(i, k)
63          u(nn,k)=u1(i,k)               u(nn, k)=u1(i, k)
64          v(nn,k)=v1(i,k)               v(nn, k)=v1(i, k)
65          gz(nn,k)=gz1(i,k)               gz(nn, k)=gz1(i, k)
66          h(nn,k)=h1(i,k)               h(nn, k)=h1(i, k)
67          lv(nn,k)=lv1(i,k)               lv(nn, k)=lv1(i, k)
68          cpn(nn,k)=cpn1(i,k)               cpn(nn, k)=cpn1(i, k)
69          p(nn,k)=p1(i,k)               p(nn, k)=p1(i, k)
70          ph(nn,k)=ph1(i,k)               ph(nn, k)=ph1(i, k)
71          tv(nn,k)=tv1(i,k)               tv(nn, k)=tv1(i, k)
72          tp(nn,k)=tp1(i,k)               tp(nn, k)=tp1(i, k)
73          tvp(nn,k)=tvp1(i,k)               tvp(nn, k)=tvp1(i, k)
74          clw(nn,k)=clw1(i,k)               clw(nn, k)=clw1(i, k)
75          th(nn,k)=th1(i,k)               th(nn, k)=th1(i, k)
76        endif            endif
77   100    continue         end do
78   110  continue      end do
79    
80  !      do 121 j=1,ntra      call assert(nn == ncum, "cv30_compress")
81  !      do 111 k=1,nd      nn=0
82  !       nn=0  
83  !      do 101 i=1,len      do i=1, klon
84  !      if(iflag1(i).eq.0)then         if (iflag1(i) == 0) then
85  !       nn=nn+1            nn=nn+1
86  !       tra(nn,k,j)=tra1(i,k,j)            pbase(nn)=pbase1(i)
87  !      endif            buoybase(nn)=buoybase1(i)
88  ! 101  continue            plcl(nn)=plcl1(i)
89  ! 111  continue            tnk(nn)=tnk1(i)
90  ! 121  continue            qnk(nn)=qnk1(i)
91              gznk(nn)=gznk1(i)
92        if (nn.ne.ncum) then            nk(nn)=nk1(i)
93           print*,'strange! nn not equal to ncum: ',nn,ncum            icb(nn)=icb1(i)
94           stop            icbs(nn)=icbs1(i)
95        endif            iflag(nn)=iflag1(i)
96           endif
97        nn=0      end do
98        do 150 i=1,len  
99        if(iflag1(i).eq.0)then    end SUBROUTINE cv30_compress
       nn=nn+1  
       pbase(nn)=pbase1(i)  
       buoybase(nn)=buoybase1(i)  
       plcl(nn)=plcl1(i)  
       tnk(nn)=tnk1(i)  
       qnk(nn)=qnk1(i)  
       gznk(nn)=gznk1(i)  
       nk(nn)=nk1(i)  
       icb(nn)=icb1(i)  
       icbs(nn)=icbs1(i)  
       iflag(nn)=iflag1(i)  
       endif  
  150  continue  
100    
101        return  end module cv30_compress_m
       end  
Legend:
Removed from v.52  
changed lines
  Added in v.195
  ViewVC Help
Powered by ViewVC 1.1.21