| Directory: | ./ |
|---|---|
| File: | phys/cv3a_compress.f90 |
| Date: | 2022-01-11 19:19:34 |
| Exec | Total | Coverage | |
|---|---|---|---|
| Lines: | 65 | 120 | 54.2% |
| Branches: | 13 | 170 | 7.6% |
| Line | Branch | Exec | Source |
|---|---|---|---|
| 1 | 480 | SUBROUTINE cv3a_compress(len, nloc, ncum, nd, ntra, compress, & | |
| 2 | 240 | iflag1, nk1, icb1, icbs1, & | |
| 3 | plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, & | ||
| 4 | 240 | wghti1, pbase1, buoybase1, & | |
| 5 | t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, & | ||
| 6 | u1, v1, gz1, th1, th1_wake, & | ||
| 7 | tra1, & | ||
| 8 | h1, lv1, lf1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, & | ||
| 9 | h1_wake, lv1_wake, lf1_wake, cpn1_wake, tv1_wake, & | ||
| 10 | sig1, w01, ptop21, & | ||
| 11 | Ale1, Alp1, omega1, & | ||
| 12 | iflag, nk, icb, icbs, & | ||
| 13 | plcl, tnk, qnk, gznk, hnk, unk, vnk, & | ||
| 14 | 240 | wghti, pbase, buoybase, & | |
| 15 | t, q, qs, t_wake, q_wake, qs_wake, s_wake, & | ||
| 16 | u, v, gz, th, th_wake, & | ||
| 17 | tra, & | ||
| 18 | h, lv, lf, cpn, p, ph, tv, tp, tvp, clw, & | ||
| 19 | h_wake, lv_wake, lf_wake, cpn_wake, tv_wake, & | ||
| 20 | sig, w0, ptop2, & | ||
| 21 | Ale, Alp, omega) | ||
| 22 | ! ************************************************************** | ||
| 23 | ! * | ||
| 24 | ! CV3A_COMPRESS * | ||
| 25 | ! * | ||
| 26 | ! * | ||
| 27 | ! written by : Sandrine Bony-Lena , 17/05/2003, 11.22.15 * | ||
| 28 | ! modified by : Jean-Yves Grandpeix, 23/06/2003, 10.28.09 * | ||
| 29 | ! ************************************************************** | ||
| 30 | |||
| 31 | IMPLICIT NONE | ||
| 32 | |||
| 33 | include "cv3param.h" | ||
| 34 | |||
| 35 | ! inputs: | ||
| 36 | INTEGER, INTENT (IN) :: len, nloc, nd, ntra | ||
| 37 | !jyg< | ||
| 38 | LOGICAL, INTENT (IN) :: compress ! compression is performed if compress is true | ||
| 39 | !>jyg | ||
| 40 | INTEGER, DIMENSION (len), INTENT (IN) :: iflag1, nk1, icb1, icbs1 | ||
| 41 | REAL, DIMENSION (len), INTENT (IN) :: plcl1, tnk1, qnk1, gznk1 | ||
| 42 | REAL, DIMENSION (len), INTENT (IN) :: hnk1, unk1, vnk1 | ||
| 43 | REAL, DIMENSION (len, nd), INTENT (IN) :: wghti1(len, nd) | ||
| 44 | REAL, DIMENSION (len), INTENT (IN) :: pbase1, buoybase1 | ||
| 45 | REAL, DIMENSION (len, nd), INTENT (IN) :: t1, q1, qs1 | ||
| 46 | REAL, DIMENSION (len, nd), INTENT (IN) :: t1_wake, q1_wake, qs1_wake | ||
| 47 | REAL, DIMENSION (len), INTENT (IN) :: s1_wake | ||
| 48 | REAL, DIMENSION (len, nd), INTENT (IN) :: u1, v1 | ||
| 49 | REAL, DIMENSION (len, nd), INTENT (IN) :: gz1, th1, th1_wake | ||
| 50 | REAL, DIMENSION (len, nd,ntra), INTENT (IN) :: tra1 | ||
| 51 | REAL, DIMENSION (len, nd), INTENT (IN) :: h1, lv1, lf1, cpn1 | ||
| 52 | REAL, DIMENSION (len, nd), INTENT (IN) :: p1 | ||
| 53 | REAL, DIMENSION (len, nd+1), INTENT (IN) :: ph1(len, nd+1) | ||
| 54 | REAL, DIMENSION (len, nd), INTENT (IN) :: tv1, tp1 | ||
| 55 | REAL, DIMENSION (len, nd), INTENT (IN) :: tvp1, clw1 | ||
| 56 | REAL, DIMENSION (len, nd), INTENT (IN) :: h1_wake, lv1_wake, cpn1_wake | ||
| 57 | REAL, DIMENSION (len, nd), INTENT (IN) :: tv1_wake, lf1_wake | ||
| 58 | REAL, DIMENSION (len, nd), INTENT (IN) :: sig1, w01 | ||
| 59 | REAL, DIMENSION (len), INTENT (IN) :: ptop21 | ||
| 60 | REAL, DIMENSION (len), INTENT (IN) :: Ale1, Alp1 | ||
| 61 | REAL, DIMENSION (len, nd), INTENT (IN) :: omega1 | ||
| 62 | ! | ||
| 63 | ! in/out | ||
| 64 | INTEGER, INTENT (INOUT) :: ncum | ||
| 65 | ! | ||
| 66 | ! outputs: | ||
| 67 | ! en fait, on a nloc=len pour l'instant (cf cv_driver) | ||
| 68 | INTEGER, DIMENSION (nloc), INTENT (OUT) :: iflag, nk, icb, icbs | ||
| 69 | REAL, DIMENSION (nloc), INTENT (OUT) :: plcl, tnk, qnk, gznk | ||
| 70 | REAL, DIMENSION (nloc), INTENT (OUT) :: hnk, unk, vnk | ||
| 71 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: wghti | ||
| 72 | REAL, DIMENSION (nloc), INTENT (OUT) :: pbase, buoybase | ||
| 73 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: t, q, qs | ||
| 74 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: t_wake, q_wake, qs_wake | ||
| 75 | REAL, DIMENSION (nloc), INTENT (OUT) :: s_wake | ||
| 76 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: u, v | ||
| 77 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: gz, th, th_wake | ||
| 78 | REAL, DIMENSION (nloc, nd,ntra), INTENT (OUT) :: tra | ||
| 79 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: h, lv, lf, cpn | ||
| 80 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: p | ||
| 81 | REAL, DIMENSION (nloc, nd+1), INTENT (OUT) :: ph | ||
| 82 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: tv, tp | ||
| 83 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: tvp, clw | ||
| 84 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: h_wake, lv_wake, cpn_wake | ||
| 85 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: tv_wake, lf_wake | ||
| 86 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: sig, w0 | ||
| 87 | REAL, DIMENSION (nloc), INTENT (OUT) :: ptop2 | ||
| 88 | REAL, DIMENSION (nloc), INTENT (OUT) :: Ale, Alp | ||
| 89 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: omega | ||
| 90 | |||
| 91 | ! local variables: | ||
| 92 | INTEGER i, k, nn, j | ||
| 93 | |||
| 94 | CHARACTER (LEN=20) :: modname = 'cv3a_compress' | ||
| 95 | CHARACTER (LEN=80) :: abort_message | ||
| 96 | |||
| 97 | !jyg< | ||
| 98 |
1/2✓ Branch 0 taken 240 times.
✗ Branch 1 not taken.
|
240 | IF (compress) THEN |
| 99 | !>jyg | ||
| 100 | |||
| 101 |
2/2✓ Branch 0 taken 6720 times.
✓ Branch 1 taken 240 times.
|
6960 | DO k = 1, nl + 1 |
| 102 | 6720 | nn = 0 | |
| 103 |
2/2✓ Branch 0 taken 6679680 times.
✓ Branch 1 taken 6720 times.
|
6686640 | DO i = 1, len |
| 104 |
2/2✓ Branch 0 taken 3558716 times.
✓ Branch 1 taken 3120964 times.
|
6686400 | IF (iflag1(i)==0) THEN |
| 105 | 3558716 | nn = nn + 1 | |
| 106 | 3558716 | wghti(nn, k) = wghti1(i, k) | |
| 107 | 3558716 | t(nn, k) = t1(i, k) | |
| 108 | 3558716 | q(nn, k) = q1(i, k) | |
| 109 | 3558716 | qs(nn, k) = qs1(i, k) | |
| 110 | 3558716 | t_wake(nn, k) = t1_wake(i, k) | |
| 111 | 3558716 | q_wake(nn, k) = q1_wake(i, k) | |
| 112 | 3558716 | qs_wake(nn, k) = qs1_wake(i, k) | |
| 113 | 3558716 | u(nn, k) = u1(i, k) | |
| 114 | 3558716 | v(nn, k) = v1(i, k) | |
| 115 | 3558716 | gz(nn, k) = gz1(i, k) | |
| 116 | 3558716 | th(nn, k) = th1(i, k) | |
| 117 | 3558716 | th_wake(nn, k) = th1_wake(i, k) | |
| 118 | 3558716 | h(nn, k) = h1(i, k) | |
| 119 | 3558716 | lv(nn, k) = lv1(i, k) | |
| 120 | 3558716 | lf(nn, k) = lf1(i, k) | |
| 121 | 3558716 | cpn(nn, k) = cpn1(i, k) | |
| 122 | 3558716 | p(nn, k) = p1(i, k) | |
| 123 | 3558716 | ph(nn, k) = ph1(i, k) | |
| 124 | 3558716 | tv(nn, k) = tv1(i, k) | |
| 125 | 3558716 | tp(nn, k) = tp1(i, k) | |
| 126 | 3558716 | tvp(nn, k) = tvp1(i, k) | |
| 127 | 3558716 | clw(nn, k) = clw1(i, k) | |
| 128 | 3558716 | h_wake(nn, k) = h1_wake(i, k) | |
| 129 | 3558716 | lv_wake(nn, k) = lv1_wake(i, k) | |
| 130 | 3558716 | lf_wake(nn, k) = lf1_wake(i, k) | |
| 131 | 3558716 | cpn_wake(nn, k) = cpn1_wake(i, k) | |
| 132 | 3558716 | tv_wake(nn, k) = tv1_wake(i, k) | |
| 133 | 3558716 | sig(nn, k) = sig1(i, k) | |
| 134 | 3558716 | w0(nn, k) = w01(i, k) | |
| 135 | 3558716 | omega(nn, k) = omega1(i, k) | |
| 136 | END IF | ||
| 137 | END DO | ||
| 138 | END DO | ||
| 139 | ! | ||
| 140 | ! AC! do 121 j=1,ntra | ||
| 141 | ! AC!ccccc do 111 k=1,nl+1 | ||
| 142 | ! AC! do 111 k=1,nd | ||
| 143 | ! AC! nn=0 | ||
| 144 | ! AC! do 101 i=1,len | ||
| 145 | ! AC! if(iflag1(i).eq.0)then | ||
| 146 | ! AC! nn=nn+1 | ||
| 147 | ! AC! tra(nn,k,j)=tra1(i,k,j) | ||
| 148 | ! AC! endif | ||
| 149 | ! AC! 101 continue | ||
| 150 | ! AC! 111 continue | ||
| 151 | ! AC! 121 continue | ||
| 152 | |||
| 153 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 240 times.
|
240 | IF (nn/=ncum) THEN |
| 154 | ✗ | PRINT *, 'WARNING nn not equal to ncum: ', nn, ncum | |
| 155 | ✗ | abort_message = '' | |
| 156 | ✗ | CALL abort_physic(modname, abort_message, 1) | |
| 157 | END IF | ||
| 158 | |||
| 159 | 240 | nn = 0 | |
| 160 |
2/2✓ Branch 0 taken 238560 times.
✓ Branch 1 taken 240 times.
|
238800 | DO i = 1, len |
| 161 |
2/2✓ Branch 0 taken 127097 times.
✓ Branch 1 taken 111463 times.
|
238800 | IF (iflag1(i)==0) THEN |
| 162 | 127097 | nn = nn + 1 | |
| 163 | 127097 | s_wake(nn) = s1_wake(i) | |
| 164 | 127097 | iflag(nn) = iflag1(i) | |
| 165 | 127097 | nk(nn) = nk1(i) | |
| 166 | 127097 | icb(nn) = icb1(i) | |
| 167 | 127097 | icbs(nn) = icbs1(i) | |
| 168 | 127097 | plcl(nn) = plcl1(i) | |
| 169 | 127097 | tnk(nn) = tnk1(i) | |
| 170 | 127097 | qnk(nn) = qnk1(i) | |
| 171 | 127097 | gznk(nn) = gznk1(i) | |
| 172 | 127097 | hnk(nn) = hnk1(i) | |
| 173 | 127097 | unk(nn) = unk1(i) | |
| 174 | 127097 | vnk(nn) = vnk1(i) | |
| 175 | 127097 | pbase(nn) = pbase1(i) | |
| 176 | 127097 | buoybase(nn) = buoybase1(i) | |
| 177 | 127097 | sig(nn, nd) = sig1(i, nd) | |
| 178 | 127097 | ptop2(nn) = ptop2(i) | |
| 179 | 127097 | Ale(nn) = Ale1(i) | |
| 180 | 127097 | Alp(nn) = Alp1(i) | |
| 181 | END IF | ||
| 182 | END DO | ||
| 183 | |||
| 184 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 240 times.
|
240 | IF (nn/=ncum) THEN |
| 185 | ✗ | PRINT *, 'WARNING nn not equal to ncum: ', nn, ncum | |
| 186 | ✗ | abort_message = '' | |
| 187 | ✗ | CALL abort_physic(modname, abort_message, 1) | |
| 188 | END IF | ||
| 189 | ! | ||
| 190 | !jyg< | ||
| 191 | ELSE !(compress) | ||
| 192 | ! | ||
| 193 | ✗ | ncum = len | |
| 194 | ! | ||
| 195 | ✗ | wghti(:,1:nl+1) = wghti1(:,1:nl+1) | |
| 196 | ✗ | t(:,1:nl+1) = t1(:,1:nl+1) | |
| 197 | ✗ | q(:,1:nl+1) = q1(:,1:nl+1) | |
| 198 | ✗ | qs(:,1:nl+1) = qs1(:,1:nl+1) | |
| 199 | ✗ | t_wake(:,1:nl+1) = t1_wake(:,1:nl+1) | |
| 200 | ✗ | q_wake(:,1:nl+1) = q1_wake(:,1:nl+1) | |
| 201 | ✗ | qs_wake(:,1:nl+1) = qs1_wake(:,1:nl+1) | |
| 202 | ✗ | u(:,1:nl+1) = u1(:,1:nl+1) | |
| 203 | ✗ | v(:,1:nl+1) = v1(:,1:nl+1) | |
| 204 | ✗ | gz(:,1:nl+1) = gz1(:,1:nl+1) | |
| 205 | ✗ | th(:,1:nl+1) = th1(:,1:nl+1) | |
| 206 | ✗ | th_wake(:,1:nl+1) = th1_wake(:,1:nl+1) | |
| 207 | ✗ | h(:,1:nl+1) = h1(:,1:nl+1) | |
| 208 | ✗ | lv(:,1:nl+1) = lv1(:,1:nl+1) | |
| 209 | ✗ | lf(:,1:nl+1) = lf1(:,1:nl+1) | |
| 210 | ✗ | cpn(:,1:nl+1) = cpn1(:,1:nl+1) | |
| 211 | ✗ | p(:,1:nl+1) = p1(:,1:nl+1) | |
| 212 | ✗ | ph(:,1:nl+1) = ph1(:,1:nl+1) | |
| 213 | ✗ | tv(:,1:nl+1) = tv1(:,1:nl+1) | |
| 214 | ✗ | tp(:,1:nl+1) = tp1(:,1:nl+1) | |
| 215 | ✗ | tvp(:,1:nl+1) = tvp1(:,1:nl+1) | |
| 216 | ✗ | clw(:,1:nl+1) = clw1(:,1:nl+1) | |
| 217 | ✗ | h_wake(:,1:nl+1) = h1_wake(:,1:nl+1) | |
| 218 | ✗ | lv_wake(:,1:nl+1) = lv1_wake(:,1:nl+1) | |
| 219 | ✗ | lf_wake(:,1:nl+1) = lf1_wake(:,1:nl+1) | |
| 220 | ✗ | cpn_wake(:,1:nl+1) = cpn1_wake(:,1:nl+1) | |
| 221 | ✗ | tv_wake(:,1:nl+1) = tv1_wake(:,1:nl+1) | |
| 222 | ✗ | sig(:,1:nl+1) = sig1(:,1:nl+1) | |
| 223 | ✗ | w0(:,1:nl+1) = w01(:,1:nl+1) | |
| 224 | ✗ | omega(:,1:nl+1) = omega1(:,1:nl+1) | |
| 225 | ! | ||
| 226 | ✗ | s_wake(:) = s1_wake(:) | |
| 227 | ✗ | iflag(:) = iflag1(:) | |
| 228 | ✗ | nk(:) = nk1(:) | |
| 229 | ✗ | icb(:) = icb1(:) | |
| 230 | ✗ | icbs(:) = icbs1(:) | |
| 231 | ✗ | plcl(:) = plcl1(:) | |
| 232 | ✗ | tnk(:) = tnk1(:) | |
| 233 | ✗ | qnk(:) = qnk1(:) | |
| 234 | ✗ | gznk(:) = gznk1(:) | |
| 235 | ✗ | hnk(:) = hnk1(:) | |
| 236 | ✗ | unk(:) = unk1(:) | |
| 237 | ✗ | vnk(:) = vnk1(:) | |
| 238 | ✗ | pbase(:) = pbase1(:) | |
| 239 | ✗ | buoybase(:) = buoybase1(:) | |
| 240 | ✗ | sig(:, nd) = sig1(:, nd) | |
| 241 | ✗ | ptop2(:) = ptop2(:) | |
| 242 | ✗ | Ale(:) = Ale1(:) | |
| 243 | ✗ | Alp(:) = Alp1(:) | |
| 244 | ! | ||
| 245 | ENDIF !(compress) | ||
| 246 | !>jyg | ||
| 247 | |||
| 248 | 240 | RETURN | |
| 249 | END SUBROUTINE cv3a_compress | ||
| 250 |