| 1 | SUBROUTINE cv3a_compress( len,nloc,ncum,nd,ntra |
|---|
| 2 | : ,iflag1,nk1,icb1,icbs1 |
|---|
| 3 | : ,plcl1,tnk1,qnk1,gznk1,hnk1,unk1,vnk1 |
|---|
| 4 | : ,wghti1,pbase1,buoybase1 |
|---|
| 5 | : ,t1,q1,qs1,t1_wake,q1_wake,qs1_wake,u1,v1,gz1,th1,th1_wake |
|---|
| 6 | : ,tra1 |
|---|
| 7 | : ,h1 ,lv1 ,cpn1 ,p1,ph1,tv1 ,tp1,tvp1,clw1 |
|---|
| 8 | : ,h1_wake,lv1_wake,cpn1_wake ,tv1_wake |
|---|
| 9 | : ,sig1,w01,ptop21 |
|---|
| 10 | : ,Ale1,Alp1 |
|---|
| 11 | o ,iflag,nk,icb,icbs |
|---|
| 12 | o ,plcl,tnk,qnk,gznk,hnk,unk,vnk |
|---|
| 13 | o ,wghti,pbase,buoybase |
|---|
| 14 | o ,t,q,qs,t_wake,q_wake,qs_wake,u,v,gz,th,th_wake |
|---|
| 15 | o ,tra |
|---|
| 16 | o ,h ,lv ,cpn ,p,ph,tv ,tp,tvp,clw |
|---|
| 17 | o ,h_wake,lv_wake,cpn_wake ,tv_wake |
|---|
| 18 | o ,sig,w0,ptop2 |
|---|
| 19 | o ,Ale,Alp ) |
|---|
| 20 | *************************************************************** |
|---|
| 21 | * * |
|---|
| 22 | * CV3A_COMPRESS * |
|---|
| 23 | * * |
|---|
| 24 | * * |
|---|
| 25 | * written by : Sandrine Bony-Lena , 17/05/2003, 11.22.15 * |
|---|
| 26 | * modified by : Jean-Yves Grandpeix, 23/06/2003, 10.28.09 * |
|---|
| 27 | *************************************************************** |
|---|
| 28 | * |
|---|
| 29 | implicit none |
|---|
| 30 | |
|---|
| 31 | #include "cv3param.h" |
|---|
| 32 | |
|---|
| 33 | c inputs: |
|---|
| 34 | integer len,nloc,ncum,nd,ntra |
|---|
| 35 | integer iflag1(len),nk1(len),icb1(len),icbs1(len) |
|---|
| 36 | real plcl1(len),tnk1(len),qnk1(len),gznk1(len) |
|---|
| 37 | real hnk1(len),unk1(len),vnk1(len) |
|---|
| 38 | real wghti1(len,nd),pbase1(len),buoybase1(len) |
|---|
| 39 | real t1(len,nd),q1(len,nd),qs1(len,nd) |
|---|
| 40 | real t1_wake(len,nd),q1_wake(len,nd),qs1_wake(len,nd) |
|---|
| 41 | real u1(len,nd),v1(len,nd) |
|---|
| 42 | real gz1(len,nd),th1(len,nd),th1_wake(len,nd) |
|---|
| 43 | real tra1(len,nd,ntra) |
|---|
| 44 | real h1(len,nd),lv1(len,nd),cpn1(len,nd) |
|---|
| 45 | real p1(len,nd),ph1(len,nd+1),tv1(len,nd),tp1(len,nd) |
|---|
| 46 | real tvp1(len,nd),clw1(len,nd) |
|---|
| 47 | real h1_wake(len,nd),lv1_wake(len,nd),cpn1_wake(len,nd) |
|---|
| 48 | real tv1_wake(len,nd) |
|---|
| 49 | real sig1(len,nd), w01(len,nd), ptop21(len) |
|---|
| 50 | real Ale1(len),Alp1(len) |
|---|
| 51 | |
|---|
| 52 | c outputs: |
|---|
| 53 | c en fait, on a nloc=len pour l'instant (cf cv_driver) |
|---|
| 54 | integer iflag(len),nk(len),icb(len),icbs(len) |
|---|
| 55 | real plcl(len),tnk(len),qnk(len),gznk(len) |
|---|
| 56 | real hnk(len),unk(len),vnk(len) |
|---|
| 57 | real wghti(len,nd),pbase(len),buoybase(len) |
|---|
| 58 | real t(len,nd),q(len,nd),qs(len,nd) |
|---|
| 59 | real t_wake(len,nd),q_wake(len,nd),qs_wake(len,nd) |
|---|
| 60 | real u(len,nd),v(len,nd) |
|---|
| 61 | real gz(len,nd),th(len,nd),th_wake(len,nd) |
|---|
| 62 | real tra(len,nd,ntra) |
|---|
| 63 | real h(len,nd),lv(len,nd),cpn(len,nd) |
|---|
| 64 | real p(len,nd),ph(len,nd+1),tv(len,nd),tp(len,nd) |
|---|
| 65 | real tvp(len,nd),clw(len,nd) |
|---|
| 66 | real h_wake(len,nd),lv_wake(len,nd),cpn_wake(len,nd) |
|---|
| 67 | real tv_wake(len,nd) |
|---|
| 68 | real sig(len,nd), w0(len,nd), ptop2(len) |
|---|
| 69 | real Ale(len),Alp(len) |
|---|
| 70 | |
|---|
| 71 | c local variables: |
|---|
| 72 | integer i,k,nn,j |
|---|
| 73 | |
|---|
| 74 | |
|---|
| 75 | do 110 k=1,nl+1 |
|---|
| 76 | nn=0 |
|---|
| 77 | do 100 i=1,len |
|---|
| 78 | if(iflag1(i).eq.0)then |
|---|
| 79 | nn=nn+1 |
|---|
| 80 | wghti(nn,k)=wghti1(i,k) |
|---|
| 81 | t(nn,k)=t1(i,k) |
|---|
| 82 | q(nn,k)=q1(i,k) |
|---|
| 83 | qs(nn,k)=qs1(i,k) |
|---|
| 84 | t_wake(nn,k)=t1_wake(i,k) |
|---|
| 85 | q_wake(nn,k)=q1_wake(i,k) |
|---|
| 86 | qs_wake(nn,k)=qs1_wake(i,k) |
|---|
| 87 | u(nn,k)=u1(i,k) |
|---|
| 88 | v(nn,k)=v1(i,k) |
|---|
| 89 | gz(nn,k)=gz1(i,k) |
|---|
| 90 | th(nn,k)=th1(i,k) |
|---|
| 91 | th_wake(nn,k)=th1_wake(i,k) |
|---|
| 92 | h(nn,k)=h1(i,k) |
|---|
| 93 | lv(nn,k)=lv1(i,k) |
|---|
| 94 | cpn(nn,k)=cpn1(i,k) |
|---|
| 95 | p(nn,k)=p1(i,k) |
|---|
| 96 | ph(nn,k)=ph1(i,k) |
|---|
| 97 | tv(nn,k)=tv1(i,k) |
|---|
| 98 | tp(nn,k)=tp1(i,k) |
|---|
| 99 | tvp(nn,k)=tvp1(i,k) |
|---|
| 100 | clw(nn,k)=clw1(i,k) |
|---|
| 101 | h_wake(nn,k)=h1_wake(i,k) |
|---|
| 102 | lv_wake(nn,k)=lv1_wake(i,k) |
|---|
| 103 | cpn_wake(nn,k)=cpn1_wake(i,k) |
|---|
| 104 | tv_wake(nn,k)=tv1_wake(i,k) |
|---|
| 105 | sig(nn,k)=sig1(i,k) |
|---|
| 106 | w0(nn,k)=w01(i,k) |
|---|
| 107 | endif |
|---|
| 108 | 100 continue |
|---|
| 109 | 110 continue |
|---|
| 110 | |
|---|
| 111 | do 121 j=1,ntra |
|---|
| 112 | ccccc do 111 k=1,nl+1 |
|---|
| 113 | do 111 k=1,nd |
|---|
| 114 | nn=0 |
|---|
| 115 | do 101 i=1,len |
|---|
| 116 | if(iflag1(i).eq.0)then |
|---|
| 117 | nn=nn+1 |
|---|
| 118 | tra(nn,k,j)=tra1(i,k,j) |
|---|
| 119 | endif |
|---|
| 120 | 101 continue |
|---|
| 121 | 111 continue |
|---|
| 122 | 121 continue |
|---|
| 123 | |
|---|
| 124 | if (nn.ne.ncum) then |
|---|
| 125 | print*,'WARNING nn not equal to ncum: ',nn,ncum |
|---|
| 126 | stop |
|---|
| 127 | endif |
|---|
| 128 | |
|---|
| 129 | nn=0 |
|---|
| 130 | do 150 i=1,len |
|---|
| 131 | if(iflag1(i).eq.0)then |
|---|
| 132 | nn=nn+1 |
|---|
| 133 | iflag(nn)=iflag1(i) |
|---|
| 134 | nk(nn)=nk1(i) |
|---|
| 135 | icb(nn)=icb1(i) |
|---|
| 136 | icbs(nn)=icbs1(i) |
|---|
| 137 | plcl(nn)=plcl1(i) |
|---|
| 138 | tnk(nn)=tnk1(i) |
|---|
| 139 | qnk(nn)=qnk1(i) |
|---|
| 140 | gznk(nn)=gznk1(i) |
|---|
| 141 | hnk(nn)=hnk1(i) |
|---|
| 142 | unk(nn)=unk1(i) |
|---|
| 143 | vnk(nn)=vnk1(i) |
|---|
| 144 | pbase(nn)=pbase1(i) |
|---|
| 145 | buoybase(nn)=buoybase1(i) |
|---|
| 146 | ptop2(nn)=ptop2(i) |
|---|
| 147 | ale(nn) = ale1(i) |
|---|
| 148 | alp(nn) = alp1(i) |
|---|
| 149 | endif |
|---|
| 150 | 150 continue |
|---|
| 151 | |
|---|
| 152 | if (nn.ne.ncum) then |
|---|
| 153 | print*,'WARNING nn not equal to ncum: ',nn,ncum |
|---|
| 154 | stop |
|---|
| 155 | endif |
|---|
| 156 | |
|---|
| 157 | RETURN |
|---|
| 158 | END |
|---|
