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