*IF DEF,CONVIEEE,AND,DEF,CRAY,AND,DEF,T3E C90EXPND.2 C *****************************COPYRIGHT****************************** C90EXPND.3 C (c) CROWN COPYRIGHT 1996, METEOROLOGICAL OFFICE, All Rights Reserved. C90EXPND.4 C C90EXPND.5 C Use, duplication or disclosure of this code is subject to the C90EXPND.6 C restrictions as set forth in the contract. C90EXPND.7 C C90EXPND.8 C Meteorological Office C90EXPND.9 C London Road C90EXPND.10 C BRACKNELL C90EXPND.11 C Berkshire UK C90EXPND.12 C RG12 2SZ C90EXPND.13 C C90EXPND.14 C If no contract has been raised with this copy of the code, the use, C90EXPND.15 C duplication or disclosure of it is strictly prohibited. Permission C90EXPND.16 C to do so must first be obtained in writing from the Head of Numerical C90EXPND.17 C Modelling at the above address. C90EXPND.18 C ******************************COPYRIGHT****************************** C90EXPND.19subroutine c90_expand21(n,in,out,nexp,inc_in) 1C90EXPND.20 implicit none C90EXPND.21 c C90EXPND.22 integer in(*), out(*) C90EXPND.23 integer int_out, msk5 C90EXPND.24 integer bias,odd,even,offset,inc_in,inc C90EXPND.25 integer msk1, msk2, msk3, msk4, i, j, n, nexp, k, l C90EXPND.26 c C90EXPND.27 data offset/0400000000000000000000b/ C90EXPND.28 data msk1/0777777777740000000000b/ C90EXPND.29 data msk2/1000000000000000000000b/ C90EXPND.30 data msk3/0000000000017777777777b/ C90EXPND.31 data msk4/0000000000020000000000b/ C90EXPND.32 data msk5/X'0000FFFFFFFFFFFF'/ C90EXPND.33 c C90EXPND.34 bias = offset - shiftl(1,nexp-1+48) C90EXPND.35 C90EXPND.36 if (numarg() .eq. 4) then C90EXPND.37 inc=1 C90EXPND.38 else C90EXPND.39 inc=inc_in C90EXPND.40 endif C90EXPND.41 C90EXPND.42 i=1 C90EXPND.43 j=1 C90EXPND.44 k=1 C90EXPND.45 do 500 l = 1,n/2 C90EXPND.46 odd = shiftr((in(i) .and. msk1),(15-nexp)) + bias C90EXPND.47 int_out = (in(i) .and. msk2) .or. odd C90EXPND.48 if(iand(int_out, msk5).eq.0) then C90EXPND.49 out(j) = 0 C90EXPND.50 else C90EXPND.51 out(j) = int_out C90EXPND.52 endif C90EXPND.53 C90EXPND.54 even = shiftl((in(i).and. msk3),17+nexp) + bias C90EXPND.55 int_out = shiftl((in(i) .and. msk4),32) .or. even C90EXPND.56 if(iand(int_out, msk5).eq.0) then C90EXPND.57 out(j+inc) = 0 C90EXPND.58 else C90EXPND.59 out(j+inc) = int_out C90EXPND.60 endif C90EXPND.61 C90EXPND.62 i = i+1 C90EXPND.63 j = j+(2*inc) C90EXPND.64 k = k+2 C90EXPND.65 500 continue C90EXPND.66 C90EXPND.67 do l = k,n C90EXPND.68 odd = shiftr((in(i) .and. msk1),(15-nexp)) + bias C90EXPND.69 int_out = (in(i) .and. msk2) .or. odd C90EXPND.70 if(iand(int_out, msk5).eq.0) then C90EXPND.71 out(j) = 0 C90EXPND.72 else C90EXPND.73 out(j) = int_out C90EXPND.74 endif C90EXPND.75 end do C90EXPND.76 C90EXPND.77 return C90EXPND.78 end C90EXPND.79 *ENDIF C90EXPND.80