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

Diff of /trunk/Sources/phylmd/CV30_routines/cv3_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/phylmd/CV3_routines/cv3_compress.f revision 97 by guez, Fri Apr 25 14:58:31 2014 UTC
# Line 1  Line 1 
1    module cv3_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 cv3_compress(len, nloc, ncum, nd, iflag1, nk1, icb1, icbs1, &
8           plcl1, tnk1, qnk1, gznk1, pbase1, buoybase1, t1, q1, qs1, u1, v1, gz1, &
9           th1, h1, lv1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, sig1, w01, iflag, &
10           nk, icb, icbs, plcl, tnk, qnk, gznk, pbase, buoybase, t, q, qs, u, v, &
11           gz, th, h, lv, cpn, p, ph, tv, tp, tvp, clw, sig, w0)
12    
13        use cv3_param_m
14    
15    
16        ! inputs:
17        integer, intent(in):: len, ncum, nd, nloc
18        integer iflag1(len), nk1(len), icb1(len), icbs1(len)
19        real plcl1(len), tnk1(len), qnk1(len), gznk1(len)
20        real pbase1(len), buoybase1(len)
21        real, intent(in):: t1(len, nd)
22        real, intent(in):: q1(len, nd), qs1(len, nd), u1(len, nd), v1(len, nd)
23        real gz1(len, nd), h1(len, nd), lv1(len, nd), cpn1(len, nd)
24        real p1(len, nd), ph1(len, nd+1), tv1(len, nd), tp1(len, nd)
25        real tvp1(len, nd), clw1(len, nd)
26        real th1(len, nd)
27        real sig1(len, nd), w01(len, nd)
28    
29        ! outputs:
30        ! en fait, on a nloc=len pour l'instant (cf cv_driver)
31        integer iflag(nloc), nk(nloc), icb(nloc), icbs(nloc)
32        real plcl(nloc), tnk(nloc), qnk(nloc), gznk(nloc)
33        real pbase(nloc), buoybase(nloc)
34        real t(nloc, nd), q(nloc, nd), qs(nloc, nd), u(nloc, nd), v(nloc, nd)
35        real gz(nloc, nd), h(nloc, nd), lv(nloc, nd), cpn(nloc, nd)
36        real p(nloc, nd), ph(nloc, nd+1), tv(nloc, nd), tp(nloc, nd)
37        real tvp(nloc, nd), clw(nloc, nd)
38        real th(nloc, nd)
39        real sig(nloc, nd), w0(nloc, nd)
40    
41        do 110 k=1,nl+1      ! local variables:
42        integer i, k, nn, j
43    
44    
45        do  k=1, nl+1
46         nn=0         nn=0
47        do 100 i=1,len         do  i=1, len
48        if(iflag1(i).eq.0)then            if(iflag1(i).eq.0)then
49          nn=nn+1               nn=nn+1
50          sig(nn,k)=sig1(i,k)               sig(nn, k)=sig1(i, k)
51          w0(nn,k)=w01(i,k)               w0(nn, k)=w01(i, k)
52          t(nn,k)=t1(i,k)               t(nn, k)=t1(i, k)
53          q(nn,k)=q1(i,k)               q(nn, k)=q1(i, k)
54          qs(nn,k)=qs1(i,k)               qs(nn, k)=qs1(i, k)
55          u(nn,k)=u1(i,k)               u(nn, k)=u1(i, k)
56          v(nn,k)=v1(i,k)               v(nn, k)=v1(i, k)
57          gz(nn,k)=gz1(i,k)               gz(nn, k)=gz1(i, k)
58          h(nn,k)=h1(i,k)               h(nn, k)=h1(i, k)
59          lv(nn,k)=lv1(i,k)               lv(nn, k)=lv1(i, k)
60          cpn(nn,k)=cpn1(i,k)               cpn(nn, k)=cpn1(i, k)
61          p(nn,k)=p1(i,k)               p(nn, k)=p1(i, k)
62          ph(nn,k)=ph1(i,k)               ph(nn, k)=ph1(i, k)
63          tv(nn,k)=tv1(i,k)               tv(nn, k)=tv1(i, k)
64          tp(nn,k)=tp1(i,k)               tp(nn, k)=tp1(i, k)
65          tvp(nn,k)=tvp1(i,k)               tvp(nn, k)=tvp1(i, k)
66          clw(nn,k)=clw1(i,k)               clw(nn, k)=clw1(i, k)
67          th(nn,k)=th1(i,k)               th(nn, k)=th1(i, k)
68        endif            endif
69   100    continue         end do
70   110  continue      end do
71    
72  !      do 121 j=1,ntra      if (nn.ne.ncum) then
73  !      do 111 k=1,nd         print*, 'strange! nn not equal to ncum: ', nn, ncum
74  !       nn=0         stop
75  !      do 101 i=1,len      endif
76  !      if(iflag1(i).eq.0)then  
77  !       nn=nn+1      nn=0
78  !       tra(nn,k,j)=tra1(i,k,j)      do  i=1, len
79  !      endif         if(iflag1(i).eq.0)then
80  ! 101  continue            nn=nn+1
81  ! 111  continue            pbase(nn)=pbase1(i)
82  ! 121  continue            buoybase(nn)=buoybase1(i)
83              plcl(nn)=plcl1(i)
84        if (nn.ne.ncum) then            tnk(nn)=tnk1(i)
85           print*,'strange! nn not equal to ncum: ',nn,ncum            qnk(nn)=qnk1(i)
86           stop            gznk(nn)=gznk1(i)
87        endif            nk(nn)=nk1(i)
88              icb(nn)=icb1(i)
89        nn=0            icbs(nn)=icbs1(i)
90        do 150 i=1,len            iflag(nn)=iflag1(i)
91        if(iflag1(i).eq.0)then         endif
92        nn=nn+1      end do
93        pbase(nn)=pbase1(i)  
94        buoybase(nn)=buoybase1(i)    end SUBROUTINE cv3_compress
       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  
95    
96        return  end module cv3_compress_m
       end  

Legend:
Removed from v.52  
changed lines
  Added in v.97

  ViewVC Help
Powered by ViewVC 1.1.21