code:
module packjt

! These variables are accessible from outside via "use packjt":
  integer jt_itype,jt_nc1,jt_nc2,jt_ng,jt_k1,jt_k2
  character*6 jt_c1,jt_c2,jt_c3

  contains

subroutine packbits(dbits,nsymd,m0,sym)

 ! Pack 0s and 1s from dbits() into sym() with m0 bits per word.
 ! NB: nsymd is the number of packed output words.

   integer sym(:)
   integer*1 dbits(:)

   k=0
   do i=1,nsymd
      n=0
      do j=1,m0
         k=k+1
         m=dbits(k)
         n=ior(ishft(n,1),m)
      enddo
      sym(i)=n
   enddo

   return
 end subroutine packbits

 subroutine unpackbits(sym,nsymd,m0,dbits)

 ! Unpack bits from sym() into dbits(), one bit per byte.
 ! NB: nsymd is the number of input words, and m0 their length.
 ! there will be m0*nsymd output bytes, each 0 or 1.

   integer sym(:)
   integer*1 dbits(:)

   k=0
   do i=1,nsymd
      mask=ishft(1,m0-1)
      do j=1,m0
         k=k+1
         dbits(k)=0
         if(iand(mask,sym(i)).ne.0) dbits(k)=1
         mask=ishft(mask,-1)
      enddo
   enddo

   return
 end subroutine unpackbits

 subroutine packcall(callsign,ncall,text)

 ! Pack a valid callsign into a 28-bit integer.

   parameter (NBASE=37*36*10*27*27*27)
   character callsign*6,c*1,tmp*6
   logical text

   text=.false.

 ! Work-around for Swaziland prefix:
   if(callsign(1:4).eq.'3DA0') callsign='3D0'//callsign(5:6)

 ! Work-around for Guinea prefixes:
   if(callsign(1:2).eq.'3X' .and. callsign(3:3).ge.'A' .and.          &
        callsign(3:3).le.'Z') callsign='Q'//callsign(3:6)

   if(callsign(1:3).eq.'CQ ') then
      ncall=NBASE + 1
      if(callsign(4:4).ge.'0' .and. callsign(4:4).le.'9' .and.        &
           callsign(5:5).ge.'0' .and. callsign(5:5).le.'9' .and.      &
           callsign(6:6).ge.'0' .and. callsign(6:6).le.'9') then
         read(callsign(4:6),*) nfreq
         ncall=NBASE + 3 + nfreq
      endif
      return
   else if(callsign(1:4).eq.'QRZ ') then
      ncall=NBASE + 2
      return
   else if(callsign(1:3).eq.'DE ') then
      ncall=267796945
      return
   endif

   tmp='      '
   if(callsign(3:3).ge.'0' .and. callsign(3:3).le.'9') then
      tmp=callsign
   else if(callsign(2:2).ge.'0' .and. callsign(2:2).le.'9') then
      if(callsign(6:6).ne.' ') then
         text=.true.
         return
      endif
      tmp=' '//callsign(:5)
   else
      text=.true.
      return
   endif

   do i=1,6
      c=tmp(i:i)
      if(c.ge.'a' .and. c.le.'z')                                &
           tmp(i:i)=char(ichar(c)-ichar('a')+ichar('A'))
   enddo

   n1=0
   if((tmp(1:1).ge.'A'.and.tmp(1:1).le.'Z').or.tmp(1:1).eq.' ') n1=1
   if(tmp(1:1).ge.'0' .and. tmp(1:1).le.'9') n1=1
   n2=0
   if(tmp(2:2).ge.'A' .and. tmp(2:2).le.'Z') n2=1
   if(tmp(2:2).ge.'0' .and. tmp(2:2).le.'9') n2=1
   n3=0
   if(tmp(3:3).ge.'0' .and. tmp(3:3).le.'9') n3=1
   n4=0
   if((tmp(4:4).ge.'A'.and.tmp(4:4).le.'Z').or.tmp(4:4).eq.' ') n4=1
   n5=0
   if((tmp(5:5).ge.'A'.and.tmp(5:5).le.'Z').or.tmp(5:5).eq.' ') n5=1
   n6=0
   if((tmp(6:6).ge.'A'.and.tmp(6:6).le.'Z').or.tmp(6:6).eq.' ') n6=1

   if(n1+n2+n3+n4+n5+n6 .ne. 6) then
      text=.true.
      return
   endif

   ncall=nchar(tmp(1:1))
   ncall=36*ncall+nchar(tmp(2:2))
   ncall=10*ncall+nchar(tmp(3:3))
   ncall=27*ncall+nchar(tmp(4:4))-10
   ncall=27*ncall+nchar(tmp(5:5))-10
   ncall=27*ncall+nchar(tmp(6:6))-10

   return
 end subroutine packcall

 subroutine unpackcall(ncall,word,iv2,psfx)

   parameter (NBASE=37*36*10*27*27*27)
   character word*12,c*37,psfx*4

   data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ '/

   word='......'
   psfx='    '
   n=ncall
   iv2=0
   if(n.ge.262177560) go to 20
   word='......'
 !  if(n.ge.262177560) go to 999            !Plain text message ...
   i=mod(n,27)+11
   word(6:6)=c(i:i)
   n=n/27
   i=mod(n,27)+11
   word(5:5)=c(i:i)
   n=n/27
   i=mod(n,27)+11
   word(4:4)=c(i:i)
   n=n/27
   i=mod(n,10)+1
   word(3:3)=c(i:i)
   n=n/10
   i=mod(n,36)+1
   word(2:2)=c(i:i)
   n=n/36
   i=n+1
   word(1:1)=c(i:i)
   do i=1,4
      if(word(i:i).ne.' ') go to 10
   enddo
   go to 999
 10 word=word(i:)
   go to 999

 20 if(n.ge.267796946) go to 999

 ! We have a JT65v2 message
   if((n.ge.262178563) .and. (n.le.264002071)) then
 ! CQ with prefix
      iv2=1
      n=n-262178563
      i=mod(n,37)+1
      psfx(4:4)=c(i:i)
      n=n/37
      i=mod(n,37)+1
      psfx(3:3)=c(i:i)
      n=n/37
      i=mod(n,37)+1
      psfx(2:2)=c(i:i)
      n=n/37
      i=n+1
      psfx(1:1)=c(i:i)

   else if((n.ge.264002072) .and. (n.le.265825580)) then
 ! QRZ with prefix
      iv2=2
      n=n-264002072
      i=mod(n,37)+1
      psfx(4:4)=c(i:i)
      n=n/37
      i=mod(n,37)+1
      psfx(3:3)=c(i:i)
      n=n/37
      i=mod(n,37)+1
      psfx(2:2)=c(i:i)
      n=n/37
      i=n+1
      psfx(1:1)=c(i:i)

   else if((n.ge.265825581) .and. (n.le.267649089)) then
 ! DE with prefix
      iv2=3
      n=n-265825581
      i=mod(n,37)+1
      psfx(4:4)=c(i:i)
      n=n/37
      i=mod(n,37)+1
      psfx(3:3)=c(i:i)
      n=n/37
      i=mod(n,37)+1
      psfx(2:2)=c(i:i)
      n=n/37
      i=n+1
      psfx(1:1)=c(i:i)

   else if((n.ge.267649090) .and. (n.le.267698374)) then
 ! CQ with suffix
      iv2=4
      n=n-267649090
      i=mod(n,37)+1
      psfx(3:3)=c(i:i)
      n=n/37
      i=mod(n,37)+1
      psfx(2:2)=c(i:i)
      n=n/37
      i=n+1
      psfx(1:1)=c(i:i)

   else if((n.ge.267698375) .and. (n.le.267747659)) then
 ! QRZ with suffix
      iv2=5
      n=n-267698375
      i=mod(n,37)+1
      psfx(3:3)=c(i:i)
      n=n/37
      i=mod(n,37)+1
      psfx(2:2)=c(i:i)
      n=n/37
      i=n+1
      psfx(1:1)=c(i:i)

   else if((n.ge.267747660) .and. (n.le.267796944)) then
 ! DE with suffix
      iv2=6
      n=n-267747660
      i=mod(n,37)+1
      psfx(3:3)=c(i:i)
      n=n/37
      i=mod(n,37)+1
      psfx(2:2)=c(i:i)
      n=n/37
      i=n+1
      psfx(1:1)=c(i:i)

   else if(n.eq.267796945) then
 ! DE with no prefix or suffix
      iv2=7
      psfx = '    '
   endif

999 if(word(1:3).eq.'3D0') word='3DA0'//word(4:)
   if(word(1:1).eq.'Q' .and. word(2:2).ge.'A' .and.                 &
        word(2:2).le.'Z') word='3X'//word(2:)

   return
 end subroutine unpackcall

 subroutine packgrid(grid,ng,text)

   parameter (NGBASE=180*180)
   character*4 grid
   character*1 c1
   logical text

   text=.false.
   if(grid.eq.'    ') go to 90               !Blank grid is OK

 ! First, handle signal reports in the original range, -01 to -30 dB
   if(grid(1:1).eq.'-') then
      read(grid(2:3),*,err=800,end=800) n
      if(n.ge.1 .and. n.le.30) then
         ng=NGBASE+1+n
         go to 900
      endif
      go to 10
   else if(grid(1:2).eq.'R-') then
      read(grid(3:4),*,err=800,end=800) n
      if(n.ge.1 .and. n.le.30) then
         ng=NGBASE+31+n
         go to 900
      endif
      go to 10
 ! Now check for RO, RRR, or 73 in the message field normally used for grid
   else if(grid(1:4).eq.'RO  ') then
      ng=NGBASE+62
      go to 900
   else if(grid(1:4).eq.'RRR ') then
      ng=NGBASE+63
      go to 900
   else if(grid(1:4).eq.'73  ') then
      ng=NGBASE+64
      go to 900
   endif

 ! Now check for extended-range signal reports: -50 to -31, and 0 to +49.
 10 n=99
   c1=grid(1:1)
   read(grid,*,err=20,end=20) n
   go to 30
 20 read(grid(2:4),*,err=30,end=30) n
 30 if(n.ge.-50 .and. n.le.49) then
      if(c1.eq.'R') then
         write(grid,1002) n+50
 1002    format('LA',i2.2)
      else
         write(grid,1003) n+50
 1003    format('KA',i2.2)
      endif
      go to 40
   endif

 ! Maybe it's free text ?
   if(grid(1:1).lt.'A' .or. grid(1:1).gt.'R') text=.true.
   if(grid(2:2).lt.'A' .or. grid(2:2).gt.'R') text=.true.
   if(grid(3:3).lt.'0' .or. grid(3:3).gt.'9') text=.true.
   if(grid(4:4).lt.'0' .or. grid(4:4).gt.'9') text=.true.
   if(text) go to 900

 ! OK, we have a properly formatted grid locator
 40 call grid2deg(grid//'mm',dlong,dlat)
   long=int(dlong)
   lat=int(dlat+ 90.0)
   ng=((long+180)/2)*180 + lat
   go to 900

 90 ng=NGBASE + 1
   go to 900

 800 text=.true.
 900 continue

   return
 end subroutine packgrid

 subroutine unpackgrid(ng,grid)

   parameter (NGBASE=180*180)
   character grid*4,grid6*6

   grid='    '
   if(ng.ge.32400) go to 10
   dlat=mod(ng,180)-90
   dlong=(ng/180)*2 - 180 + 2
   call deg2grid(dlong,dlat,grid6)
   grid=grid6(:4)
   if(grid(1:2).eq.'KA') then
      read(grid(3:4),*) n
      n=n-50
      write(grid,1001) n
 1001 format(i3.2)
      if(grid(1:1).eq.' ') grid(1:1)='+'
   else if(grid(1:2).eq.'LA') then
      read(grid(3:4),*) n
      n=n-50
      write(grid,1002) n
 1002 format('R',i3.2)
      if(grid(2:2).eq.' ') grid(2:2)='+'
   endif
   go to 900

 10 n=ng-NGBASE-1
   if(n.ge.1 .and.n.le.30) then
      write(grid,1012) -n
 1012 format(i3.2)
   else if(n.ge.31 .and.n.le.60) then
      n=n-30
      write(grid,1022) -n
 1022 format('R',i3.2)
   else if(n.eq.61) then
      grid='RO'
   else if(n.eq.62) then
      grid='RRR'
   else if(n.eq.63) then
      grid='73'
   endif

 900 return
 end subroutine unpackgrid

 subroutine packmsg(msg0,dat,itype,bcontest)

 ! Packs a JT4/JT9/JT65 message into twelve 6-bit symbols

 ! itype Message Type
 !--------------------
 !   1   Standardd message
 !   2   Type 1 prefix
 !   3   Type 1 suffix
 !   4   Type 2 prefix
 !   5   Type 2 suffix
 !   6   Free text
 !  -1   Does not decode correctly

   parameter (NBASE=37*36*10*27*27*27)
   parameter (NBASE2=262178562)
   character*22 msg0,msg
   integer dat(:)
   character*12 c1,c2
   character*4 c3
   character*6 grid6
   logical text1,text2,text3,bcontest

   itype=1
   if(bcontest) then
      call to_contest_msg(msg0,msg)
   else
      msg=msg0
   end if

   call fmtmsg(msg,iz)
   if(msg(1:3).eq.'CQ ' .and. msg(4:4).ge.'0' .and. msg(4:4).le.'9'   &
        .and. msg(5:5).eq.' ') msg='CQ 00'//msg(4:)

   if(msg(1:6).eq.'CQ DX ') msg(3:3)='9'
   if(msg(1:3).eq.'CQ ' .and.                                         &
        msg(4:4).ge.'A' .and. msg(4:4).le.'Z' .and.                   &
        msg(5:5).ge.'A' .and. msg(5:5).le.'Z' .and.                   &
        msg(6:6).eq.' ') msg='E9'//msg(4:)

 ! See if it's a CQ message
   if(msg(1:3).eq.'CQ ') then
      i=3
 ! ... and if so, does it have a reply frequency?
      if(msg(4:4).ge.'0' .and. msg(4:4).le.'9' .and.                  &
           msg(5:5).ge.'0' .and. msg(5:5).le.'9' .and.                &
           msg(6:6).ge.'0' .and. msg(6:6).le.'9') i=7
      go to 1
   endif

   do i=1,22
      if(msg(i:i).eq.' ') go to 1       !Get 1st blank
   enddo
   go to 10                             !Consider msg as plain text

 1 ia=i
   c1=msg(1:ia-1)
   do i=ia+1,22
      if(msg(i:i).eq.' ') go to 2       !Get 2nd blank
   enddo
   go to 10                             !Consider msg as plain text

 2 ib=i
   c2=msg(ia+1:ib-1)

   do i=ib+1,22
      if(msg(i:i).eq.' ') go to 3       !Get 3rd blank
   enddo
   go to 10                             !Consider msg as plain text

 3 ic=i
   c3='    '
   if(ic.ge.ib+1) c3=msg(ib+1:ic)
   if(c3.eq.'OOO ') c3='    '           !Strip out the OOO flag
   call getpfx1(c1,k1,nv2a)
   if(nv2a.ge.4) go to 10
   call packcall(c1,nc1,text1)
   if(text1) go to 10
   call getpfx1(c2,k2,nv2b)
   call packcall(c2,nc2,text2)
   if(text2) go to 10
   if(nv2a.eq.2 .or. nv2a.eq.3 .or. nv2b.eq.2 .or. nv2b.eq.3) then
      if(k1.lt.0 .or. k2.lt.0 .or. k1*k2.ne.0) go to 10
      if(k2.gt.0) k2=k2+450
      k=max(k1,k2)
      if(k.gt.0) then
         call k2grid(k,grid6)
         c3=grid6(:4)
      endif
   endif
   call packgrid(c3,ng,text3)

   if(nv2a.lt.4 .and. nv2b.lt.4 .and. (.not.text1) .and. (.not.text2) .and.  &
        (.not.text3)) go to 20

   nc1=0
   if(nv2b.eq.4) then
      if(c1(1:3).eq.'CQ ' .and. (.not.text3))  nc1=262178563 + k2
      if(c1(1:4).eq.'QRZ ' .and. (.not.text3)) nc1=264002072 + k2
      if(c1(1:3).eq.'DE ' .and. (.not.text3))  nc1=265825581 + k2
   else if(nv2b.eq.5) then
      if(c1(1:3).eq.'CQ ' .and. (.not.text3))  nc1=267649090 + k2
      if(c1(1:4).eq.'QRZ ' .and. (.not.text3)) nc1=267698375 + k2
      if(c1(1:3).eq.'DE ' .and. (.not.text3))  nc1=267747660 + k2
   endif
   if(nc1.ne.0) go to 20

 ! The message will be treated as plain text.
 10 itype=6
   call packtext(msg,nc1,nc2,ng)
   ng=ng+32768

 ! Encode data into 6-bit words
20 continue
   if(itype.ne.6) itype=max(nv2a,nv2b)
   jt_itype=itype
   jt_c1=c1(1:6)
   jt_c2=c2(1:6)
   jt_c3=c3
   jt_k1=k1
   jt_k2=k2
   jt_nc1=nc1
   jt_nc2=nc2
   jt_ng=ng
   dat(1)=iand(ishft(nc1,-22),63)                !6 bits
   dat(2)=iand(ishft(nc1,-16),63)                !6 bits
   dat(3)=iand(ishft(nc1,-10),63)                !6 bits
   dat(4)=iand(ishft(nc1, -4),63)                !6 bits
   dat(5)=4*iand(nc1,15)+iand(ishft(nc2,-26),3)  !4+2 bits
   dat(6)=iand(ishft(nc2,-20),63)                !6 bits
   dat(7)=iand(ishft(nc2,-14),63)                !6 bits
   dat(8)=iand(ishft(nc2, -8),63)                !6 bits
   dat(9)=iand(ishft(nc2, -2),63)                !6 bits
   dat(10)=16*iand(nc2,3)+iand(ishft(ng,-12),15) !2+4 bits
   dat(11)=iand(ishft(ng,-6),63)
   dat(12)=iand(ng,63)

   return
 end subroutine packmsg

 subroutine unpackmsg(dat,msg,bcontest,mygrid)

   parameter (NBASE=37*36*10*27*27*27)
   parameter (NGBASE=180*180)
   integer dat(:)
   character c1*12,c2*12,grid*4,msg*22,grid6*6,psfx*4,junk2*4,mygrid*6
   logical cqnnn,bcontest

   cqnnn=.false.
   nc1=ishft(dat(1),22) + ishft(dat(2),16) + ishft(dat(3),10)+         &
        ishft(dat(4),4) + iand(ishft(dat(5),-2),15)

   nc2=ishft(iand(dat(5),3),26) + ishft(dat(6),20) +                   &
        ishft(dat(7),14) + ishft(dat(8),8) + ishft(dat(9),2) +         &
        iand(ishft(dat(10),-4),3)

   ng=ishft(iand(dat(10),15),12) + ishft(dat(11),6) + dat(12)

   if(ng.ge.32768) then
      call unpacktext(nc1,nc2,ng,msg)
      go to 100
   endif

   call unpackcall(nc1,c1,iv2,psfx)
   if(iv2.eq.0) then
 ! This is an "original JT65" message
      if(nc1.eq.NBASE+1) c1='CQ    '
      if(nc1.eq.NBASE+2) c1='QRZ   '
      nfreq=nc1-NBASE-3
      if(nfreq.ge.0 .and. nfreq.le.999) then
         write(c1,1002) nfreq
 1002    format('CQ ',i3.3)
         cqnnn=.true.
      endif
   endif

   call unpackcall(nc2,c2,junk1,junk2)
   call unpackgrid(ng,grid)

   if(iv2.gt.0) then
 ! This is a JT65v2 message
      do i=1,4
         if(ichar(psfx(i:i)).eq.0) psfx(i:i)=' '
      enddo

      n1=len_trim(psfx)
      n2=len_trim(c2)
      if(iv2.eq.1) msg='CQ '//psfx(:n1)//'/'//c2(:n2)//' '//grid
      if(iv2.eq.2) msg='QRZ '//psfx(:n1)//'/'//c2(:n2)//' '//grid
      if(iv2.eq.3) msg='DE '//psfx(:n1)//'/'//c2(:n2)//' '//grid
      if(iv2.eq.4) msg='CQ '//c2(:n2)//'/'//psfx(:n1)//' '//grid
      if(iv2.eq.5) msg='QRZ '//c2(:n2)//'/'//psfx(:n1)//' '//grid
      if(iv2.eq.6) msg='DE '//c2(:n2)//'/'//psfx(:n1)//' '//grid
      if(iv2.eq.7) then
         grid6=grid//'ma'
         call grid2k(grid6,k)
         if(k.ge.451 .and. k.le.900) then
            call getpfx2(k,c2)
            n2=len_trim(c2)
            msg='DE '//c2(:n2)
         else
            msg='DE '//c2(:n2)//' '//grid
         endif
      endif
      if(iv2.eq.8) msg=' '
      go to 100
   else

   endif

   grid6=grid//'ma'
   call grid2k(grid6,k)
   if(k.ge.1 .and. k.le.450)   call getpfx2(k,c1)
   if(k.ge.451 .and. k.le.900) call getpfx2(k,c2)

   i=index(c1,char(0))
   if(i.ge.3) c1=c1(1:i-1)//'            '
   i=index(c2,char(0))
   if(i.ge.3) c2=c2(1:i-1)//'            '

   msg='                      '
   j=0
   if(cqnnn) then
      msg=c1//'          '
      j=7                                  !### ??? ###
      go to 10
   endif

   do i=1,12
      j=j+1
      msg(j:j)=c1(i:i)
      if(c1(i:i).eq.' ') go to 10
   enddo
   j=j+1
   msg(j:j)=' '

 10 do i=1,12
      if(j.le.21) j=j+1
      msg(j:j)=c2(i:i)
      if(c2(i:i).eq.' ') go to 20
   enddo
   if(j.le.21) j=j+1
   msg(j:j)=' '

 20 if(k.eq.0) then
      do i=1,4
         if(j.le.21) j=j+1
         msg(j:j)=grid(i:i)
      enddo
      if(j.le.21) j=j+1
      msg(j:j)=' '
   endif

 100 continue
   if(msg(1:6).eq.'CQ9DX ') msg(3:3)=' '
   if(msg(1:2).eq.'E9' .and.                                          &
        msg(3:3).ge.'A' .and. msg(3:3).le.'Z' .and.                   &
        msg(4:4).ge.'A' .and. msg(4:4).le.'Z' .and.                   &
        msg(5:5).eq.' ') msg='CQ '//msg(3:)

   if(bcontest) call fix_contest_msg(mygrid,msg)

   if(msg(1:5).eq.'CQ 00' .and. msg(6:6).ge.'0' .and.                 &
        msg(6:6).le.'9') msg='CQ '//msg(6:)

   return
 end subroutine unpackmsg

 subroutine packtext(msg,nc1,nc2,nc3)

   parameter (MASK28=2**28 - 1)
   character*22 msg
   character*42 c
   data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ +-./?'/

   nc1=0
   nc2=0
   nc3=0

   do i=1,5                                !First 5 characters in nc1
      do j=1,42                            !Get character code
         if(msg(i:i).eq.c(j:j)) go to 10
      enddo
      j=37
 10   j=j-1                                !Codes should start at zero
      nc1=42*nc1 + j
   enddo

   do i=6,10                               !Characters 6-10 in nc2
      do j=1,42                            !Get character code
         if(msg(i:i).eq.c(j:j)) go to 20
      enddo
      j=37
 20   j=j-1                                !Codes should start at zero
      nc2=42*nc2 + j
   enddo

   do i=11,13                              !Characters 11-13 in nc3
      do j=1,42                            !Get character code
         if(msg(i:i).eq.c(j:j)) go to 30
      enddo
      j=37
 30   j=j-1                                !Codes should start at zero
      nc3=42*nc3 + j
   enddo

 ! We now have used 17 bits in nc3.  Must move one each to nc1 and nc2.
   nc1=nc1+nc1
   if(iand(nc3,32768).ne.0) nc1=nc1+1
   nc2=nc2+nc2
   if(iand(nc3,65536).ne.0) nc2=nc2+1
   nc3=iand(nc3,32767)

   return
 end subroutine packtext

 subroutine unpacktext(nc1,nc2,nc3,msg)

   character*22 msg
   character*44 c
   data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ +-./?'/

   nc3=iand(nc3,32767)                      !Remove the "plain text" bit
   if(iand(nc1,1).ne.0) nc3=nc3+32768
   nc1=nc1/2
   if(iand(nc2,1).ne.0) nc3=nc3+65536
   nc2=nc2/2

   do i=5,1,-1
      j=mod(nc1,42)+1
      msg(i:i)=c(j:j)
      nc1=nc1/42
   enddo

   do i=10,6,-1
      j=mod(nc2,42)+1
      msg(i:i)=c(j:j)
      nc2=nc2/42
   enddo

   do i=13,11,-1
      j=mod(nc3,42)+1
      msg(i:i)=c(j:j)
      nc3=nc3/42
   enddo
   msg(14:22) = '         '

   return
 end subroutine unpacktext

 subroutine getpfx1(callsign,k,nv2)

   character*12 callsign0,callsign,lof,rof
   character*8 c
   character addpfx*8,tpfx*4,tsfx*3
   logical ispfx,issfx,invalid
   common/pfxcom/addpfx
   include 'pfx.f90'

   callsign0=callsign
   nv2=1
   iz=index(callsign,' ') - 1
   if(iz.lt.0) iz=12
   islash=index(callsign(1:iz),'/')
   k=0
 !  if(k.eq.0) go to 10     !Tnx to DL9RDZ for reminder:this was for tests only!
   c='   '
   if(islash.gt.0 .and. islash.le.(iz-4)) then
 ! Add-on prefix
      c=callsign(1:islash-1)
      callsign=callsign(islash+1:iz)
      do i=1,NZ
         if(pfx(i)(1:4).eq.c) then
            k=i
            nv2=2
            go to 10
         endif
      enddo
      if(addpfx.eq.c) then
         k=449
         nv2=2
         go to 10
      endif

   else if(islash.eq.(iz-1)) then
 ! Add-on suffix
      c=callsign(islash+1:iz)
      callsign=callsign(1:islash-1)
      do i=1,NZ2
         if(sfx(i).eq.c(1:1)) then
            k=400+i
            nv2=3
            go to 10
         endif
      enddo
   endif

 10 if(islash.ne.0 .and.k.eq.0) then
 ! Original JT65 would force this compound callsign to be treated as
 ! plain text.  In JT65v2, we will encode the prefix or suffix into nc1.
 ! The task here is to compute the proper value of k.
      lof=callsign0(:islash-1)
      rof=callsign0(islash+1:)
      llof=len_trim(lof)
      lrof=len_trim(rof)
      ispfx=(llof.gt.0 .and. llof.le.4)
      issfx=(lrof.gt.0 .and. lrof.le.3)
      invalid=.not.(ispfx.or.issfx)
      if(ispfx.and.issfx) then
         if(llof.lt.3) issfx=.false.
         if(lrof.lt.3) ispfx=.false.
         if(ispfx.and.issfx) then
            i=ichar(callsign0(islash-1:islash-1))
            if(i.ge.ichar('0') .and. i.le.ichar('9')) then
               issfx=.false.
            else
               ispfx=.false.
            endif
         endif
      endif

      if(invalid) then
         k=-1
      else
         if(ispfx) then
            tpfx=lof(1:4)
            k=nchar(tpfx(1:1))
            k=37*k + nchar(tpfx(2:2))
            k=37*k + nchar(tpfx(3:3))
            k=37*k + nchar(tpfx(4:4))
            nv2=4
            i=index(callsign0,'/')
            callsign=callsign0(:i-1)
            callsign=callsign0(i+1:)
         endif
         if(issfx) then
            tsfx=rof(1:3)
            k=nchar(tsfx(1:1))
            k=37*k + nchar(tsfx(2:2))
            k=37*k + nchar(tsfx(3:3))
            nv2=5
            i=index(callsign0,'/')
            callsign=callsign0(:i-1)
         endif
      endif
   endif

   return
 end subroutine getpfx1

 subroutine getpfx2(k0,callsign)

   character callsign*12
   include 'pfx.f90'
   character addpfx*8
   common/pfxcom/addpfx

   k=k0
   if(k.gt.450) k=k-450
   if(k.ge.1 .and. k.le.NZ) then
      iz=index(pfx(k),' ') - 1
      callsign=pfx(k)(1:iz)//'/'//callsign
   else if(k.ge.401 .and. k.le.400+NZ2) then
      iz=index(callsign,' ') - 1
      callsign=callsign(1:iz)//'/'//sfx(k-400)
   else if(k.eq.449) then
      iz=index(addpfx,' ') - 1
      if(iz.lt.1) iz=8
      callsign=addpfx(1:iz)//'/'//callsign
   endif

   return
 end subroutine getpfx2

 subroutine grid2k(grid,k)

   character*6 grid

   call grid2deg(grid,xlong,xlat)
   nlong=nint(xlong)
   nlat=nint(xlat)
   k=0
   if(nlat.ge.85) k=5*(nlong+179)/2 + nlat-84

   return
 end subroutine grid2k

 subroutine k2grid(k,grid)
   character grid*6

   nlong=2*mod((k-1)/5,90)-179
   if(k.gt.450) nlong=nlong+180
   nlat=mod(k-1,5)+ 85
   dlat=nlat
   dlong=nlong
   call deg2grid(dlong,dlat,grid)

   return
 end subroutine k2grid

 subroutine grid2n(grid,n)
   character*4 grid

   i1=ichar(grid(1:1))-ichar('A')
   i2=ichar(grid(3:3))-ichar('0')
   i=10*i1 + i2
   n=-i - 31

   return
 end subroutine grid2n

 subroutine n2grid(n,grid)
   character*4 grid

   if(n.gt.-31 .or. n.lt.-70) stop 'Error in n2grid'
   i=-(n+31)                           !NB: 0 <= i <= 39
   i1=i/10
   i2=mod(i,10)
   grid(1:1)=char(ichar('A')+i1)
   grid(2:2)='A'
   grid(3:3)=char(ichar('0')+i2)
   grid(4:4)='0'

   return
 end subroutine n2grid

 function nchar(c)

 ! Convert ascii number, letter, or space to 0-36 for callsign packing.

   character c*1

   n=0                                    !Silence compiler warning
   if(c.ge.'0' .and. c.le.'9') then
      n=ichar(c)-ichar('0')
   else if(c.ge.'A' .and. c.le.'Z') then
      n=ichar(c)-ichar('A') + 10
   else if(c.ge.'a' .and. c.le.'z') then
      n=ichar(c)-ichar('a') + 10
   else if(c.ge.' ') then
      n=36
   else
      Print*,'Invalid character in callsign ',c,' ',ichar(c)
      stop
   endif
   nchar=n

   return
 end function nchar

 subroutine pack50(n1,n2,dat)

   integer*1 dat(:),i1

   i1=iand(ishft(n1,-20),255)                !8 bits
   dat(1)=i1
   i1=iand(ishft(n1,-12),255)                 !8 bits
   dat(2)=i1
   i1=iand(ishft(n1, -4),255)                 !8 bits
   dat(3)=i1
   i1=16*iand(n1,15)+iand(ishft(n2,-18),15)   !4+4 bits
   dat(4)=i1
   i1=iand(ishft(n2,-10),255)                 !8 bits
   dat(5)=i1
   i1=iand(ishft(n2, -2),255)                 !8 bits
   dat(6)=i1
   i1=64*iand(n2,3)                           !2 bits
   dat(7)=i1
   dat(8)=0
   dat(9)=0
   dat(10)=0
   dat(11)=0

   return
 end subroutine pack50

subroutine packpfx(call1,n1,ng,nadd)

  character*12 call1,call0
  character*3 pfx
  logical text

  i1=index(call1,'/')
  if(call1(i1+2:i1+2).eq.' ') then
! Single-character add-on suffix (maybe also fourth suffix letter?)
     call0=call1(:i1-1)
     call packcall(call0,n1,text)
     nadd=1
     nc=ichar(call1(i1+1:i1+1))
     if(nc.ge.48 .and. nc.le.57) then
        n=nc-48
     else if(nc.ge.65 .and. nc.le.90) then
        n=nc-65+10
     else
        n=38
     endif
     nadd=1
     ng=60000-32768+n
  else if(call1(i1+3:i1+3).eq.' ') then
! Two-character numerical suffix, /10 to /99
     call0=call1(:i1-1)
     call packcall(call0,n1,text)
     nadd=1
     n=10*(ichar(call1(i1+1:i1+1))-48) + ichar(call1(i1+2:i1+2)) - 48
     nadd=1
     ng=60000 + 26 + n
  else
! Prefix of 1 to 3 characters
     pfx=call1(:i1-1)
     if(pfx(3:3).eq.' ') pfx=' '//pfx(1:2)
     if(pfx(3:3).eq.' ') pfx=' '//pfx(1:2)
     call0=call1(i1+1:)
     call packcall(call0,n1,text)

     ng=0
     do i=1,3
        nc=ichar(pfx(i:i))
        if(nc.ge.48 .and. nc.le.57) then
           n=nc-48
        else if(nc.ge.65 .and. nc.le.90) then
           n=nc-65+10
        else
           n=36
        endif
        ng=37*ng + n
     enddo
     nadd=0
     if(ng.ge.32768) then
        ng=ng-32768
        nadd=1
     endif
  endif

  return
end subroutine packpfx

end module packjt


code:
#ifndef BOOST_SERIALIZATION_TRACKING_HPP
#define BOOST_SERIALIZATION_TRACKING_HPP

// MS compatible compilers support #pragma once
#if defined(_MSC_VER)
# pragma once
#endif

/////////1/////////2/////////3/////////4/////////5/////////6/////////7/////////8
// tracking.hpp:

// (C) Copyright 2002 Robert Ramey - http://www.rrsd.com .
// Use, modification and distribution is subject to the Boost Software
// License, Version 1.0. (See accompanying file LICENSE_1_0.txt or copy at
// http://www.boost.org/LICENSE_1_0.txt)

//  See http://www.boost.org for updates, documentation, and revision history.

#include <boost/config.hpp>
#include <boost/static_assert.hpp>
#include <boost/mpl/eval_if.hpp>
#include <boost/mpl/identity.hpp>
#include <boost/mpl/int.hpp>
#include <boost/mpl/equal_to.hpp>
#include <boost/mpl/greater.hpp>
#include <boost/mpl/integral_c_tag.hpp>

#include <boost/type_traits/is_base_and_derived.hpp>
#include <boost/type_traits/is_pointer.hpp>
#include <boost/serialization/level.hpp>
#include <boost/serialization/tracking_enum.hpp>
#include <boost/serialization/type_info_implementation.hpp>

namespace boost {
namespace serialization {

struct basic_traits;

// default tracking level
template<class T>
struct tracking_level_impl {
    template<class U>
    struct traits_class_tracking {
        typedef typename U::tracking type;
    };
    typedef mpl::integral_c_tag tag;
    // note: at least one compiler complained w/o the full qualification
    // on basic traits below
    typedef
        typename mpl::eval_if<
            is_base_and_derived<boost::serialization::basic_traits, T>,
            traits_class_tracking< T >,
        //else
        typename mpl::eval_if<
            is_pointer< T >,
            // pointers are not tracked by default
            mpl::int_<track_never>,
        //else
        typename mpl::eval_if<
            // for primitives
            typename mpl::equal_to<
                implementation_level< T >,
                mpl::int_<primitive_type>
            >,
            // is never
            mpl::int_<track_never>,
            // otherwise its selective
            mpl::int_<track_selectively>
    >  > >::type type;
    BOOST_STATIC_CONSTANT(int, value = type::value);
};

template<class T>
struct tracking_level :
    public tracking_level_impl<const T>
{
};

template<class T, enum tracking_type L>
inline bool operator>=(tracking_level< T > t, enum tracking_type l)
{
    return t.value >= (int)l;
}

} // namespace serialization
} // namespace boost

// The STATIC_ASSERT is prevents one from setting tracking for a primitive type.
// This almost HAS to be an error.  Doing this will effect serialization of all
// char's in your program which is almost certainly what you don't want to do.
// If you want to track all instances of a given primitive type, You'll have to
// wrap it in your own type so its not a primitive anymore.  Then it will compile
// without problem.
#define BOOST_CLASS_TRACKING(T, E)           \
namespace boost {                            \
namespace serialization {                    \
template<>                                   \
struct tracking_level< T >                   \
{                                            \
    typedef mpl::integral_c_tag tag;         \
    typedef mpl::int_< E> type;              \
    BOOST_STATIC_CONSTANT(                   \
        int,                                 \
        value = tracking_level::type::value  \
    );                                       \
    /* tracking for a class  */              \
    BOOST_STATIC_ASSERT((                    \
        mpl::greater<                        \
            /* that is a prmitive */         \
            implementation_level< T >,       \
            mpl::int_<primitive_type>        \
        >::value                             \
    ));                                      \
};                                           \
}}

#endif // BOOST_SERIALIZATION_TRACKING_HPP

license: mit


code:
// Boost.Units - A C++ library for zero-overhead dimensional analysis and
// unit/quantity manipulation and conversion
//
// Copyright (C) 2003-2008 Matthias Christian Schabel
// Copyright (C) 2007-2008 Steven Watanabe
//
// Distributed under the Boost Software License, Version 1.0. (See
// accompanying file LICENSE_1_0.txt or copy at
// http://www.boost.org/LICENSE_1_0.txt)

#ifndef BOOST_UNITS_REDUCE_UNIT_HPP_INCLUDED
#define BOOST_UNITS_REDUCE_UNIT_HPP_INCLUDED

/// \file
/// \brief Returns a unique type for every unit.

namespace boost {
namespace units {

#ifdef BOOST_UNITS_DOXYGEN

/// Returns a unique type for every unit.
template<class Unit>
struct reduce_unit {
    typedef detail::unspecified type;
};

#else

// default implementation: return Unit unchanged.
template<class Unit>
struct reduce_unit {
    typedef Unit type;
};

#endif

}
}

#endif


code:
//  filesystem path_traits.hpp  --------------------------------------------------------//

//  Copyright Beman Dawes 2009

//  Distributed under the Boost Software License, Version 1.0.
//  See http://www.boost.org/LICENSE_1_0.txt

//  Library home page: http://www.boost.org/libs/filesystem

#ifndef BOOST_FILESYSTEM_PATH_TRAITS_HPP
#define BOOST_FILESYSTEM_PATH_TRAITS_HPP

#include <boost/config.hpp>

# if defined( BOOST_NO_STD_WSTRING )
#   error Configuration not supported: Boost.Filesystem V3 and later requires std::wstring support
# endif

#include <boost/filesystem/config.hpp>
#include <boost/utility/enable_if.hpp>
#include <boost/type_traits/is_array.hpp>
#include <boost/type_traits/decay.hpp>
#include <boost/system/error_code.hpp>
#include <cwchar>  // for mbstate_t
#include <string>
#include <vector>
#include <list>
#include <iterator>
#include <locale>
#include <boost/assert.hpp>
// #include <iostream>   //**** comment me out ****

#include <boost/config/abi_prefix.hpp> // must be the last #include

namespace boost { namespace filesystem {

  BOOST_FILESYSTEM_DECL const system::error_category& codecvt_error_category();
  //  uses std::codecvt_base::result used for error codes:
  //
  //    ok:       Conversion successful.
  //    partial:  Not all source characters converted; one or more additional source
  //              characters are needed to produce the final target character, or the
  //              size of the target intermediate buffer was too small to hold the result.
  //    error:    A character in the source could not be converted to the target encoding.
  //    noconv:   The source and target characters have the same type and encoding, so no
  //              conversion was necessary.

  class directory_entry;

namespace path_traits {

  typedef std::codecvt<wchar_t, char, std::mbstate_t> codecvt_type;

  //  is_pathable type trait; allows disabling over-agressive class path member templates

  template <class T>
  struct is_pathable { static const bool value = false; };

  template<> struct is_pathable<char*>                  { static const bool value = true; };
  template<> struct is_pathable<const char*>            { static const bool value = true; };
  template<> struct is_pathable<wchar_t*>               { static const bool value = true; };
  template<> struct is_pathable<const wchar_t*>         { static const bool value = true; };
  template<> struct is_pathable<std::string>            { static const bool value = true; };
  template<> struct is_pathable<std::wstring>           { static const bool value = true; };
  template<> struct is_pathable<std::vector<char> >     { static const bool value = true; };
  template<> struct is_pathable<std::vector<wchar_t> >  { static const bool value = true; };
  template<> struct is_pathable<std::list<char> >       { static const bool value = true; };
  template<> struct is_pathable<std::list<wchar_t> >    { static const bool value = true; };
  template<> struct is_pathable<directory_entry>        { static const bool value = true; };

  //  Pathable empty

  template <class Container> inline
    // disable_if aids broken compilers (IBM, old GCC, etc.) and is harmless for
    // conforming compilers. Replace by plain "bool" at some future date (2012?)
    typename boost::disable_if<boost::is_array<Container>, bool>::type
      empty(const Container & c)
        { return c.begin() == c.end(); }

  template <class T> inline
    bool empty(T * const & c_str)
  {
    BOOST_ASSERT(c_str);
    return !*c_str;
  }

  template <typename T, size_t N> inline
     bool empty(T (&x)[N])
       { return !x[0]; }

  // value types differ  ---------------------------------------------------------------//
  //
  //   A from_end argument of 0 is less efficient than a known end, so use only if needed

  //  with codecvt

  BOOST_FILESYSTEM_DECL
    void convert(const char* from,
    const char* from_end,    // 0 for null terminated MBCS
    std::wstring & to,
    const codecvt_type& cvt);

  BOOST_FILESYSTEM_DECL
    void convert(const wchar_t* from,
    const wchar_t* from_end,  // 0 for null terminated MBCS
    std::string & to,
    const codecvt_type& cvt);

  inline
    void convert(const char* from,
    std::wstring & to,
    const codecvt_type& cvt)
  {
    BOOST_ASSERT(from);
    convert(from, 0, to, cvt);
  }

  inline
    void convert(const wchar_t* from,
    std::string & to,
    const codecvt_type& cvt)
  {
    BOOST_ASSERT(from);
    convert(from, 0, to, cvt);
  }

  //  without codecvt

  inline
    void convert(const char* from,
    const char* from_end,    // 0 for null terminated MBCS
    std::wstring & to);

  inline
    void convert(const wchar_t* from,
    const wchar_t* from_end,  // 0 for null terminated MBCS
    std::string & to);

  inline
    void convert(const char* from,
    std::wstring & to);

  inline
    void convert(const wchar_t* from,
    std::string & to);

  // value types same  -----------------------------------------------------------------//

  // char with codecvt

  inline
    void convert(const char* from, const char* from_end, std::string & to,
    const codecvt_type&)
  {
    BOOST_ASSERT(from);
    BOOST_ASSERT(from_end);
    to.append(from, from_end);
  }

  inline
    void convert(const char* from,
    std::string & to,
    const codecvt_type&)
  {
    BOOST_ASSERT(from);
    to += from;
  }

  // wchar_t with codecvt

  inline
    void convert(const wchar_t* from, const wchar_t* from_end, std::wstring & to,
    const codecvt_type&)
  {
    BOOST_ASSERT(from);
    BOOST_ASSERT(from_end);
    to.append(from, from_end);
  }

  inline
    void convert(const wchar_t* from,
    std::wstring & to,
    const codecvt_type&)
  {
    BOOST_ASSERT(from);
    to += from;
  }

  // char without codecvt

  inline
    void convert(const char* from, const char* from_end, std::string & to)
  {
    BOOST_ASSERT(from);
    BOOST_ASSERT(from_end);
    to.append(from, from_end);
  }

  inline
    void convert(const char* from, std::string & to)
  {
    BOOST_ASSERT(from);
    to += from;
  }

  // wchar_t without codecvt

  inline
    void convert(const wchar_t* from, const wchar_t* from_end, std::wstring & to)
  {
    BOOST_ASSERT(from);
    BOOST_ASSERT(from_end);
    to.append(from, from_end);
  }

  inline
    void convert(const wchar_t* from, std::wstring & to)
  {
    BOOST_ASSERT(from);
    to += from;
  }

  //  Source dispatch  -----------------------------------------------------------------//

  //  contiguous containers with codecvt
  template <class U> inline
    void dispatch(const std::string& c, U& to, const codecvt_type& cvt)
  {
    if (c.size())
      convert(&*c.begin(), &*c.begin() + c.size(), to, cvt);
  }
  template <class U> inline
    void dispatch(const std::wstring& c, U& to, const codecvt_type& cvt)
  {
    if (c.size())
      convert(&*c.begin(), &*c.begin() + c.size(), to, cvt);
  }
  template <class U> inline
    void dispatch(const std::vector<char>& c, U& to, const codecvt_type& cvt)
  {
    if (c.size())
      convert(&*c.begin(), &*c.begin() + c.size(), to, cvt);
  }
  template <class U> inline
    void dispatch(const std::vector<wchar_t>& c, U& to, const codecvt_type& cvt)
  {
    if (c.size())
      convert(&*c.begin(), &*c.begin() + c.size(), to, cvt);
  }

  //  contiguous containers without codecvt
  template <class U> inline
    void dispatch(const std::string& c, U& to)
  {
    if (c.size())
      convert(&*c.begin(), &*c.begin() + c.size(), to);
  }
  template <class U> inline
    void dispatch(const std::wstring& c, U& to)
  {
    if (c.size())
      convert(&*c.begin(), &*c.begin() + c.size(), to);
  }
  template <class U> inline
    void dispatch(const std::vector<char>& c, U& to)
  {
    if (c.size())
      convert(&*c.begin(), &*c.begin() + c.size(), to);
  }
  template <class U> inline
    void dispatch(const std::vector<wchar_t>& c, U& to)
  {
    if (c.size())
      convert(&*c.begin(), &*c.begin() + c.size(), to);
  }

  //  non-contiguous containers with codecvt
  template <class Container, class U> inline
    // disable_if aids broken compilers (IBM, old GCC, etc.) and is harmless for
    // conforming compilers. Replace by plain "void" at some future date (2012?)
    typename boost::disable_if<boost::is_array<Container>, void>::type
    dispatch(const Container & c, U& to, const codecvt_type& cvt)
  {
    if (c.size())
    {
      std::basic_string<typename Container::value_type> s(c.begin(), c.end());
      convert(s.c_str(), s.c_str()+s.size(), to, cvt);
    }
  }

  //  c_str
  template <class T, class U> inline
    void dispatch(T * const & c_str, U& to, const codecvt_type& cvt)
  {
    //    std::cout << "dispatch() const T *\n";
    BOOST_ASSERT(c_str);
    convert(c_str, to, cvt);
  }

  //  Note: there is no dispatch on C-style arrays because the array may
  //  contain a string smaller than the array size.

  BOOST_FILESYSTEM_DECL
    void dispatch(const directory_entry & de,
#                ifdef BOOST_WINDOWS_API
    std::wstring & to,
#                else
    std::string & to,
#                endif
    const codecvt_type&);

  //  non-contiguous containers without codecvt
  template <class Container, class U> inline
    // disable_if aids broken compilers (IBM, old GCC, etc.) and is harmless for
    // conforming compilers. Replace by plain "void" at some future date (2012?)
    typename boost::disable_if<boost::is_array<Container>, void>::type
    dispatch(const Container & c, U& to)
  {
    if (c.size())
    {
      std::basic_string<typename Container::value_type> seq(c.begin(), c.end());
      convert(seq.c_str(), seq.c_str()+seq.size(), to);
    }
  }

  //  c_str
  template <class T, class U> inline
    void dispatch(T * const & c_str, U& to)
  {
    //    std::cout << "dispatch() const T *\n";
    BOOST_ASSERT(c_str);
    convert(c_str, to);
  }

  //  Note: there is no dispatch on C-style arrays because the array may
  //  contain a string smaller than the array size.

  BOOST_FILESYSTEM_DECL
    void dispatch(const directory_entry & de,
#                ifdef BOOST_WINDOWS_API
    std::wstring & to
#                else
    std::string & to
#                endif
    );

}}} // namespace boost::filesystem::path_traits

#include <boost/config/abi_suffix.hpp> // pops abi_prefix.hpp pragmas

#endif  // BOOST_FILESYSTEM_PATH_TRAITS_HPP


code:
//  (c) Copyright Fernando Luis Cacciola Carballal 2000-2004
//  Use, modification, and distribution is subject to the Boost Software
//  License, Version 1.0. (See accompanying file LICENSE_1_0.txt or copy at
//  http://www.boost.org/LICENSE_1_0.txt)

//  See library home page at http://www.boost.org/libs/numeric/conversion
//
// Contact the author at: fernando_cacciola@hotmail.com
//
#ifndef BOOST_NUMERIC_CONVERSION_SIGN_MIXTURE_ENUM_FLC_12NOV2002_HPP
#define BOOST_NUMERIC_CONVERSION_SIGN_MIXTURE_ENUM_FLC_12NOV2002_HPP

namespace boost { namespace numeric
{
  enum sign_mixture_enum
  {
     unsigned_to_unsigned
    ,signed_to_signed
    ,signed_to_unsigned
    ,unsigned_to_signed
  } ;

} } // namespace boost::numeric

#endif
//
///////////////////////////////////////////////////////////////////////////////////////////////


code:
//  Copyright (c) 2006 Xiaogang Zhang
//  Use, modification and distribution are subject to the
//  Boost Software License, Version 1.0. (See accompanying file
//  LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)

#ifndef BOOST_MATH_BESSEL_K1_HPP
#define BOOST_MATH_BESSEL_K1_HPP

#ifdef _MSC_VER
#pragma once
#pragma warning(push)
#pragma warning(disable:4702) // Unreachable code (release mode only warning)
#endif

#include <boost/math/tools/rational.hpp>
#include <boost/math/tools/big_constant.hpp>
#include <boost/math/policies/error_handling.hpp>
#include <boost/assert.hpp>

// Modified Bessel function of the second kind of order one
// minimax rational approximations on intervals, see
// Russon and Blair, Chalk River Report AECL-3461, 1969

namespace boost { namespace math { namespace detail{

template <typename T, typename Policy>
T bessel_k1(T x, const Policy&);

template <class T, class Policy>
struct bessel_k1_initializer
{
   struct init
   {
      init()
      {
         do_init();
      }
      static void do_init()
      {
         bessel_k1(T(1), Policy());
      }
      void force_instantiate()const{}
   };
   static const init initializer;
   static void force_instantiate()
   {
      initializer.force_instantiate();
   }
};

template <class T, class Policy>
const typename bessel_k1_initializer<T, Policy>::init bessel_k1_initializer<T, Policy>::initializer;

template <typename T, typename Policy>
T bessel_k1(T x, const Policy& pol)
{
    bessel_k1_initializer<T, Policy>::force_instantiate();

    static const T P1[] = {
        static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, -2.2149374878243304548e+06)),
         static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, 7.1938920065420586101e+05)),
         static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, 1.7733324035147015630e+05)),
         static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, 7.1885382604084798576e+03)),
         static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, 9.9991373567429309922e+01)),
         static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, 4.8127070456878442310e-01))
    };
    static const T Q1[] = {
        static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, -2.2149374878243304548e+06)),
         static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, 3.7264298672067697862e+04)),
        static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, -2.8143915754538725829e+02)),
         static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, 1.0))
    };
    static const T P2[] = {
         static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, 0.0)),
        static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, -1.3531161492785421328e+06)),
        static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, -1.4758069205414222471e+05)),
        static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, -4.5051623763436087023e+03)),
        static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, -5.3103913335180275253e+01)),
        static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, -2.2795590826955002390e-01))
    };
    static const T Q2[] = {
        static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, -2.7062322985570842656e+06)),
        static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, 4.3117653211351080007e+04)),
        static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, -3.0507151578787595807e+02)),
        static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, 1.0))
    };
    static const T P3[] = {
         static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, 2.2196792496874548962e+00)),
         static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, 4.4137176114230414036e+01)),
         static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, 3.4122953486801312910e+02)),
         static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, 1.3319486433183221990e+03)),
         static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, 2.8590657697910288226e+03)),
         static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, 3.4540675585544584407e+03)),
         static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, 2.3123742209168871550e+03)),
         static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, 8.1094256146537402173e+02)),
         static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, 1.3182609918569941308e+02)),
         static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, 7.5584584631176030810e+00)),
         static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, 6.4257745859173138767e-02))
    };
    static const T Q3[] = {
         static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, 1.7710478032601086579e+00)),
         static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, 3.4552228452758912848e+01)),
         static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, 2.5951223655579051357e+02)),
         static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, 9.6929165726802648634e+02)),
         static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, 1.9448440788918006154e+03)),
         static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, 2.1181000487171943810e+03)),
         static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, 1.2082692316002348638e+03)),
         static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, 3.3031020088765390854e+02)),
         static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, 3.6001069306861518855e+01)),
         static_cast<T>(BOOST_MATH_BIG_CONSTANT(T, 64, 1.0))
    };
    T value, factor, r, r1, r2;

    BOOST_MATH_STD_USING
    using namespace boost::math::tools;

    static const char* function = "boost::math::bessel_k1<%1%>(%1%,%1%)";

    if (x < 0)
    {
       return policies::raise_domain_error<T>(function,
            "Got x = %1%, but argument x must be non-negative, complex number result not supported.", x, pol);
    }
    if (x == 0)
    {
       return policies::raise_overflow_error<T>(function, 0, pol);
    }
    if (x <= 1)                         // x in (0, 1]
    {
        T y = x * x;
        r1 = evaluate_polynomial(P1, y) /  evaluate_polynomial(Q1, y);
        r2 = evaluate_polynomial(P2, y) /  evaluate_polynomial(Q2, y);
        factor = log(x);
        value = (r1 + factor * r2) / x;
    }
    else                                // x in (1, \infty)
    {
        T y = 1 / x;
        r = evaluate_polynomial(P3, y) /  evaluate_polynomial(Q3, y);
        factor = exp(-x) / sqrt(x);
        value = factor * r;
    }

    return value;
}

}}} // namespaces

#ifdef _MSC_VER
#pragma warning(pop)
#endif

#endif // BOOST_MATH_BESSEL_K1_HPP


code:
#if !defined(BOOST_PP_IS_ITERATING)

// Copyright David Abrahams 2002.
// Distributed under the Boost Software License, Version 1.0. (See
// accompanying file LICENSE_1_0.txt or copy at
// http://www.boost.org/LICENSE_1_0.txt)

# ifndef SIGNATURE_DWA20021121_HPP
#  define SIGNATURE_DWA20021121_HPP

#  include <boost/python/type_id.hpp>

#  include <boost/python/detail/preprocessor.hpp>
#  include <boost/python/detail/indirect_traits.hpp>
#  include <boost/python/converter/pytype_function.hpp>

#  include <boost/preprocessor/iterate.hpp>
#  include <boost/preprocessor/iteration/local.hpp>

#  include <boost/mpl/at.hpp>
#  include <boost/mpl/size.hpp>

namespace boost { namespace python { namespace detail {

struct signature_element
{
    char const* basename;
    converter::pytype_function pytype_f;
    bool lvalue;
};

struct py_func_sig_info
{
    signature_element const *signature;
    signature_element const *ret;
};

template <unsigned> struct signature_arity;

#  define BOOST_PP_ITERATION_PARAMS_1                                            \
        (3, (0, BOOST_PYTHON_MAX_ARITY + 1, <boost/python/detail/signature.hpp>))
#  include BOOST_PP_ITERATE()

// A metafunction returning the base class used for
//
//   signature<class F, class CallPolicies, class Sig>.
//
template <class Sig>
struct signature_base_select
{
    enum { arity = mpl::size<Sig>::value - 1 };
    typedef typename signature_arity<arity>::template impl<Sig> type;
};

template <class Sig>
struct signature
    : signature_base_select<Sig>::type
{
};

}}} // namespace boost::python::detail

# endif // SIGNATURE_DWA20021121_HPP

#else

# define N BOOST_PP_ITERATION()

template <>
struct signature_arity<N>
{
    template <class Sig>
    struct impl
    {
        static signature_element const* elements()
        {
            static signature_element const result[N+2] = {

#ifndef BOOST_PYTHON_NO_PY_SIGNATURES
# define BOOST_PP_LOCAL_MACRO(i)                                                            \
                {                                                                           \
                  type_id<BOOST_DEDUCED_TYPENAME mpl::at_c<Sig,i>::type>().name()           \
                  , &converter::expected_pytype_for_arg<BOOST_DEDUCED_TYPENAME mpl::at_c<Sig,i>::type>::get_pytype   \
                  , indirect_traits::is_reference_to_non_const<BOOST_DEDUCED_TYPENAME mpl::at_c<Sig,i>::type>::value \
                },
#else
# define BOOST_PP_LOCAL_MACRO(i)                                                            \
                {                                                                           \
                  type_id<BOOST_DEDUCED_TYPENAME mpl::at_c<Sig,i>::type>().name()           \
                  , 0 \
                  , indirect_traits::is_reference_to_non_const<BOOST_DEDUCED_TYPENAME mpl::at_c<Sig,i>::type>::value \
                },
#endif

# define BOOST_PP_LOCAL_LIMITS (0, N)
# include BOOST_PP_LOCAL_ITERATE()
                {0,0,0}
            };
            return result;
        }
    };
};

#endif // BOOST_PP_IS_ITERATING


code:
/*=============================================================================
    Copyright (c) 2001-2007 Joel de Guzman

    Distributed under the Boost Software License, Version 1.0. (See accompanying
    file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
==============================================================================*/

#if !BOOST_PHOENIX_IS_ITERATING

#include <boost/phoenix/core/expression.hpp>
#include <boost/phoenix/core/detail/function_eval.hpp>

namespace boost { namespace phoenix {
    template <typename F>
    inline
    typename detail::expression::function_eval<F>::type const
    bind(F f)
    {
        return detail::expression::function_eval<F>::make(f);
    }

#if !defined(BOOST_PHOENIX_DONT_USE_PREPROCESSED_FILES)
    #include <boost/phoenix/bind/detail/cpp03/preprocessed/bind_function_object.hpp>
#else

#if defined(__WAVE__) && defined (BOOST_PHOENIX_CREATE_PREPROCESSED_FILES)
    #pragma wave option(preserve: 2, line: 0, output: "preprocessed/bind_function_object_" BOOST_PHOENIX_LIMIT_STR ".hpp")
#endif

/*=============================================================================
    Copyright (c) 2001-2007 Joel de Guzman

    Distributed under the Boost Software License, Version 1.0. (See accompanying
    file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
==============================================================================*/

#if defined(__WAVE__) && defined(BOOST_PHOENIX_CREATE_PREPROCESSED_FILES)
    #pragma wave option(preserve: 1)
#endif

#define BOOST_PHOENIX_ITERATION_PARAMS                                          \
    (3, (1, BOOST_PP_DEC(BOOST_PHOENIX_ACTOR_LIMIT),                            \
            <boost/phoenix/bind/detail/cpp03/bind_function_object.hpp>))
#include BOOST_PHOENIX_ITERATE()

#if defined(__WAVE__) && defined (BOOST_PHOENIX_CREATE_PREPROCESSED_FILES)
    #pragma wave option(output: null)
#endif

#endif

}}

#else

    template <
        typename F
      , BOOST_PHOENIX_typename_A
    >
    inline
    typename detail::expression::function_eval<
        F
      , BOOST_PHOENIX_A
    >::type const
    bind(F f, BOOST_PHOENIX_A_const_ref_a)
    {
        return
            detail::expression::function_eval<F, BOOST_PHOENIX_A>::make(
                f
              , BOOST_PHOENIX_a
            );
    }

#endif


code:
/*=============================================================================
    Copyright (c) 2011 Thomas Heller

    Distributed under the Boost Software License, Version 1.0. (See accompanying
    file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
==============================================================================*/
#if !BOOST_PHOENIX_IS_ITERATING

        template <typename F, BOOST_PHOENIX_typename_A_void(BOOST_PP_DEC(BOOST_PHOENIX_COMPOSITE_LIMIT)), typename Dummy = void>
        struct has_phx2_result
            : mpl::false_
        {};

        template <typename F, BOOST_PHOENIX_typename_A_void(BOOST_PP_DEC(BOOST_PHOENIX_COMPOSITE_LIMIT)), typename Dummy = void>
        struct phx2_result;

#if !defined(BOOST_PHOENIX_DONT_USE_PREPROCESSED_FILES)
#include <boost/phoenix/core/detail/cpp03/preprocessed/phx2_result.hpp>
#else
#if defined(__WAVE__) && defined(BOOST_PHOENIX_CREATE_PREPROCESSED_FILES)
#pragma wave option(preserve: 2, line: 0, output: "preprocessed/phx2_result_" BOOST_PHOENIX_LIMIT_STR ".hpp")
#endif
/*=============================================================================
    Copyright (c) 2011 Thomas Heller

    Distributed under the Boost Software License, Version 1.0. (See accompanying
    file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
==============================================================================*/
#if defined(__WAVE__) && defined(BOOST_PHOENIX_CREATE_PREPROCESSED_FILES)
#pragma wave option(preserve: 1)
#endif

        #define BOOST_PHOENIX_ITERATION_PARAMS                                  \
            (3, (1, BOOST_PP_DEC(BOOST_PHOENIX_COMPOSITE_LIMIT),                \
            <boost/phoenix/core/detail/cpp03/phx2_result.hpp>))
#include BOOST_PHOENIX_ITERATE()

#if defined(__WAVE__) && defined(BOOST_PHOENIX_CREATE_PREPROCESSED_FILES)
#pragma wave option(output: null)
#endif

#endif

#else

        template <typename F, BOOST_PHOENIX_typename_A>
        struct has_phx2_result<F, BOOST_PHOENIX_A>
            : mpl::eval_if<
                has_result_type<F>
              , mpl::false_
              , has_phx2_result_impl<typename F::template result<F(BOOST_PHOENIX_A)> >
            >::type
        {};

        template <typename F, BOOST_PHOENIX_typename_A>
        struct phx2_result<F, BOOST_PHOENIX_A>
        {
            typedef typename F::template result<BOOST_PHOENIX_A>::type type;
        };

        template <typename F, BOOST_PHOENIX_typename_A>
        struct phx2_result<F, BOOST_PHOENIX_A_ref>
        {
            typedef typename F::template result<BOOST_PHOENIX_A>::type type;
        };

        template <typename F, BOOST_PHOENIX_typename_A>
        struct phx2_result<F, BOOST_PHOENIX_A_const_ref>
        {
            typedef typename F::template result<BOOST_PHOENIX_A>::type type;
        };

#endif


code:
// Boost.Assign library
//
//  Copyright Thorsten Ottosen 2003-2004. Use, modification and
//  distribution is subject to the Boost Software License, Version
//  1.0. (See accompanying file LICENSE_1_0.txt or copy at
//  http://www.boost.org/LICENSE_1_0.txt)
//
// For more information, see http://www.boost.org/libs/assign/
//

#ifndef BOOST_ASSIGN_STD_SLIST_HPP
#define BOOST_ASSIGN_STD_SLIST_HPP

#include <boost/config.hpp>
#ifdef BOOST_HAS_SLIST

#if defined(_MSC_VER)
# pragma once
#endif

#include <boost/assign/list_inserter.hpp>
#ifdef BOOST_SLIST_HEADER
# include BOOST_SLIST_HEADER
#else
# include <slist>
#endif

namespace boost
{
namespace assign
{

    template< class V, class A, class V2 >
    inline list_inserter< assign_detail::call_push_back< BOOST_STD_EXTENSION_NAMESPACE::slist<V,A> >, V >
    operator+=( BOOST_STD_EXTENSION_NAMESPACE::slist<V,A>& c, V2 v )
    {
        return push_back( c )( v );
    }

}
}

#endif // BOOST_HAS_SLIST

#endif


code:
// Copyright Jim Bosch 2010-2012.
// Copyright Stefan Seefeld 2016.
// Distributed under the Boost Software License, Version 1.0.
// (See accompanying file LICENSE_1_0.txt or copy at
// http://www.boost.org/LICENSE_1_0.txt)

#ifndef boost_python_numpy_dtype_hpp_
#define boost_python_numpy_dtype_hpp_

/**
 *  @file boost/python/numpy/dtype.hpp
 *  @brief Object manager for Python's numpy.dtype class.
 */

#include <boost/python.hpp>
#include <boost/python/numpy/numpy_object_mgr_traits.hpp>

#include <boost/mpl/for_each.hpp>
#include <boost/type_traits/add_pointer.hpp>

namespace boost { namespace python { namespace numpy {

/**
 *  @brief A boost.python "object manager" (subclass of object) for numpy.dtype.
 *
 *  @todo This could have a lot more interesting accessors.
 */
class dtype : public object {
  static python::detail::new_reference convert(object::object_cref arg, bool align);
public:

  /// @brief Convert an arbitrary Python object to a data-type descriptor object.
  template <typename T>
  explicit dtype(T arg, bool align=false) : object(convert(arg, align)) {}

  /**
   *  @brief Get the built-in numpy dtype associated with the given scalar template type.
   *
   *  This is perhaps the most useful part of the numpy API: it returns the dtype object
   *  corresponding to a built-in C++ type.  This should work for any integer or floating point
   *  type supported by numpy, and will also work for std::complex if
   *  sizeof(std::complex<T>) == 2*sizeof(T).
   *
   *  It can also be useful for users to add explicit specializations for POD structs
   *  that return field-based dtypes.
   */
  template <typename T> static dtype get_builtin();

  /// @brief Return the size of the data type in bytes.
  int get_itemsize() const;

  /**
   *  @brief Compare two dtypes for equivalence.
   *
   *  This is more permissive than equality tests.  For instance, if long and int are the same
   *  size, the dtypes corresponding to each will be equivalent, but not equal.
   */
  friend bool equivalent(dtype const & a, dtype const & b);

  /**
   *  @brief Register from-Python converters for NumPy's built-in array scalar types.
   *
   *  This is usually called automatically by initialize(), and shouldn't be called twice
   *  (doing so just adds unused converters to the Boost.Python registry).
   */
  static void register_scalar_converters();

  BOOST_PYTHON_FORWARD_OBJECT_CONSTRUCTORS(dtype, object);

};

bool equivalent(dtype const & a, dtype const & b);

namespace detail
{

template <int bits, bool isUnsigned> dtype get_int_dtype();

template <int bits> dtype get_float_dtype();

template <int bits> dtype get_complex_dtype();

template <typename T, bool isInt=boost::is_integral<T>::value>
struct builtin_dtype;

template <typename T>
struct builtin_dtype<T,true> {
  static dtype get() { return get_int_dtype< 8*sizeof(T), boost::is_unsigned<T>::value >(); }
};

template <>
struct builtin_dtype<bool,true> {
  static dtype get();
};

template <typename T>
struct builtin_dtype<T,false> {
  static dtype get() { return get_float_dtype< 8*sizeof(T) >(); }
};

template <typename T>
struct builtin_dtype< std::complex<T>, false > {
  static dtype get() { return get_complex_dtype< 16*sizeof(T) >(); }
};

} // namespace detail

template <typename T>
inline dtype dtype::get_builtin() { return detail::builtin_dtype<T>::get(); }

} // namespace boost::python::numpy

namespace converter {
NUMPY_OBJECT_MANAGER_TRAITS(numpy::dtype);
}}} // namespace boost::python::converter

#endif


code:
subroutine avecho(id2,ndop,nfrit,nqual,f1,xlevel,sigdb,snr,dfreq,width)

  integer TXLENGTH
  parameter (TXLENGTH=27648)           !27*1024
  parameter (NFFT=32768,NH=NFFT/2)
  parameter (NZ=4096)
  integer*2 id2(34560)                 !Buffer for Rx data
  real sa(NZ)      !Avg spectrum relative to initial Doppler echo freq
  real sb(NZ)      !Avg spectrum with Dither and changing Doppler removed
  integer nsum       !Number of integrations
  real dop0          !Doppler shift for initial integration (Hz)
  real dop           !Doppler shift for current integration (Hz)
  real s(8192)
  real x(NFFT)
  integer ipkv(1)
  complex c(0:NH)
  equivalence (x,c),(ipk,ipkv)
  common/echocom/nclearave,nsum,blue(NZ),red(NZ)
  save dop0,sa,sb

  dop=ndop
  sq=0.
  do i=1,TXLENGTH
     x(i)=id2(i)
     sq=sq + x(i)*x(i)
  enddo
  xlevel=10.0*log10(sq/TXLENGTH)

  if(nclearave.ne.0) nsum=0
  if(nsum.eq.0) then
     dop0=dop                             !Remember the initial Doppler
     sa=0.                                !Clear the average arrays
     sb=0.
  endif

  x(TXLENGTH+1:)=0.
  x=x/TXLENGTH
  call four2a(x,NFFT,1,-1,0)
  df=12000.0/NFFT
  do i=1,8192                             !Get spectrum 0 - 3 kHz
     s(i)=real(c(i))**2 + aimag(c(i))**2
  enddo

  fnominal=1500.0           !Nominal audio frequency w/o doppler or dither
  ia=nint((fnominal+dop0-nfrit)/df)
  ib=nint((f1+dop-nfrit)/df)
  if(ia.lt.600 .or. ib.lt.600) go to 900
  if(ia.gt.7590 .or. ib.gt.7590) go to 900

  nsum=nsum+1

  do i=1,NZ
     sa(i)=sa(i) + s(ia+i-2048)    !Center at initial doppler freq
     sb(i)=sb(i) + s(ib+i-2048)    !Center at expected echo freq
  enddo

  call pctile(sb,200,50,r0)
  call pctile(sb(1800),200,50,r1)

  sum=0.
  sq=0.
  do i=1,NZ
     y=r0 + (r1-r0)*(i-100.0)/1800.0
     blue(i)=sa(i)/y
     red(i)=sb(i)/y
     if(i.le.500 .or. i.ge.3597) then
        sum=sum+red(i)
        sq=sq + (red(i)-1.0)**2
     endif
  enddo
  ave=sum/1000.0
  rms=sqrt(sq/1000.0)

  redmax=maxval(red)
  ipkv=maxloc(red)
  fac=10.0/max(redmax,10.0)
  dfreq=(ipk-2048)*df
  snr=(redmax-ave)/rms

  sigdb=-99.0
  if(ave.gt.0.0) sigdb=10.0*log10(redmax/ave - 1.0) - 35.7

  nqual=0
  if(nsum.ge.2 .and. nsum.lt.4)  nqual=(snr-4)/5
  if(nsum.ge.4 .and. nsum.lt.8)  nqual=(snr-3)/4
  if(nsum.ge.8 .and. nsum.lt.12) nqual=(snr-3)/3
  if(nsum.ge.12) nqual=(snr-2.5)/2.5
  if(nqual.lt.0)  nqual=0
  if(nqual.gt.10) nqual=10

! Scale for plotting
  blue=fac*blue
  red=fac*red

  sum=0.
  do i=ipk,ipk+300
     if(i.gt.NZ) exit
     if(red(i).lt.1.0) exit
     sum=sum+(red(i)-1.0)
  enddo
  do i=ipk-1,ipk-300,-1
     if(i.lt.1) exit
     if(red(i).lt.1.0) exit
     sum=sum+(red(i)-1.0)
  enddo
  bins=sum/(red(ipk)-1.0)
  width=df*bins
  nsmo=max(0.0,0.25*bins)

  do i=1,nsmo
     call smo121(red,NZ)
     call smo121(blue,NZ)
  enddo

900  return
end subroutine avecho


code:
// Boost.Units - A C++ library for zero-overhead dimensional analysis and
// unit/quantity manipulation and conversion
//
// Copyright (C) 2003-2008 Matthias Christian Schabel
// Copyright (C) 2007-2008 Steven Watanabe
//
// Distributed under the Boost Software License, Version 1.0. (See
// accompanying file LICENSE_1_0.txt or copy at
// http://www.boost.org/LICENSE_1_0.txt)

/// \file
/// \brief base dimensions (mass, length, time...).
/// \details base dimension definition registration.

#ifndef BOOST_UNITS_BASE_DIMENSION_HPP
#define BOOST_UNITS_BASE_DIMENSION_HPP

#include <boost/units/config.hpp>
#include <boost/units/dim.hpp>
#include <boost/units/static_rational.hpp>
#include <boost/units/units_fwd.hpp>
#include <boost/units/detail/dimension_list.hpp>
#include <boost/units/detail/ordinal.hpp>
#include <boost/units/detail/prevent_redefinition.hpp>

namespace boost {

namespace units {

/// This must be in namespace boost::units so that ADL
/// will work with friend functions defined inline.
/// INTERNAL ONLY
template<long N> struct base_dimension_ordinal { };

/// INTERNAL ONLY
template<class T, long N> struct base_dimension_pair { };

/// INTERNAL ONLY
template<class T, long N>
struct check_base_dimension {
    enum {
        value =
            sizeof(boost_units_is_registered(units::base_dimension_ordinal<N>())) == sizeof(detail::yes) &&
            sizeof(boost_units_is_registered(units::base_dimension_pair<T, N>())) != sizeof(detail::yes)
    };
};

/// Defines a base dimension.  To define a dimension you need to provide
/// the derived class (CRTP) and a unique integer.
/// @code
/// struct my_dimension : boost::units::base_dimension<my_dimension, 1> {};
/// @endcode
/// It is designed so that you will get an error message if you try
/// to use the same value in multiple definitions.
template<class Derived,
         long N
#if !defined(BOOST_UNITS_DOXYGEN) && !defined(__BORLANDC__)
         ,
         class = typename detail::ordinal_has_already_been_defined<
             check_base_dimension<Derived, N>::value
         >::type
#endif
>
class base_dimension :
    public ordinal<N>
{
    public:
        /// INTERNAL ONLY
        typedef base_dimension                                                          this_type;
        /// A convenience typedef.  Equivalent to boost::units::derived_dimension<Derived,1>::type.
#ifndef BOOST_UNITS_DOXYGEN
        typedef list<dim<Derived,static_rational<1> >, dimensionless_type>    dimension_type;
#else
        typedef detail::unspecified dimension_type;
#endif
        /// Provided for mpl compatability.
        typedef Derived type;

    private:
        /// Check for C++0x.  In C++0x, we have to have identical
        /// arguments but a different return type to trigger an
        /// error.  Note that this is only needed for clang as
        /// check_base_dimension will trigger an error earlier
        /// for compilers with less strict name lookup.
        /// INTERNAL ONLY
        friend Derived*
        check_double_register(const units::base_dimension_ordinal<N>&)
        { return(0); }

        /// Register this ordinal
        /// INTERNAL ONLY
        friend detail::yes
        boost_units_is_registered(const units::base_dimension_ordinal<N>&)
        { detail::yes result; return(result); }

        /// But make sure we can identify the current instantiation!
        /// INTERNAL ONLY
        friend detail::yes
        boost_units_is_registered(const units::base_dimension_pair<Derived, N>&)
        { detail::yes result; return(result); }
};

} // namespace units

} // namespace boost

#endif // BOOST_UNITS_BASE_DIMENSION_HPP


code:
#ifndef BOOST_MPL_INTEGRAL_C_HPP_INCLUDED
#define BOOST_MPL_INTEGRAL_C_HPP_INCLUDED

// Copyright Aleksey Gurtovoy 2000-2006
//
// Distributed under the Boost Software License, Version 1.0.
// (See accompanying file LICENSE_1_0.txt or copy at
// http://www.boost.org/LICENSE_1_0.txt)
//
// See http://www.boost.org/libs/mpl for documentation.

// $Id$
// $Date$
// $Revision$

#include <boost/mpl/integral_c_fwd.hpp>
#include <boost/mpl/aux_/config/ctps.hpp>
#include <boost/mpl/aux_/config/static_constant.hpp>
#include <boost/mpl/aux_/config/workaround.hpp>

#if BOOST_WORKAROUND(__HP_aCC, <= 53800)
// the type of non-type template arguments may not depend on template arguments
#   define AUX_WRAPPER_PARAMS(N) typename T, long N
#else
#   define AUX_WRAPPER_PARAMS(N) typename T, T N
#endif

#define AUX_WRAPPER_NAME integral_c
#define AUX_WRAPPER_VALUE_TYPE T
#define AUX_WRAPPER_INST(value) AUX_WRAPPER_NAME< T, value >
#include <boost/mpl/aux_/integral_wrapper.hpp>

#if !defined(BOOST_NO_TEMPLATE_PARTIAL_SPECIALIZATION) \
 && !BOOST_WORKAROUND(__BORLANDC__, <= 0x551)
BOOST_MPL_AUX_ADL_BARRIER_NAMESPACE_OPEN
// 'bool' constant doesn't have 'next'/'prior' members
template< bool C >
struct integral_c<bool, C>
{
    BOOST_STATIC_CONSTANT(bool, value = C);
    typedef integral_c_tag tag;
    typedef integral_c type;
    typedef bool value_type;
    operator bool() const { return this->value; }
};
BOOST_MPL_AUX_ADL_BARRIER_NAMESPACE_CLOSE
#endif

#endif // BOOST_MPL_INTEGRAL_C_HPP_INCLUDED


code:
//  (C) Copyright John Maddock 2007.
//  Use, modification and distribution are subject to the
//  Boost Software License, Version 1.0. (See accompanying file
//  LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
//
//  This file is machine generated, do not edit by hand

// Polynomial evaluation using second order Horners rule
#ifndef BOOST_MATH_TOOLS_POLY_EVAL_5_HPP
#define BOOST_MATH_TOOLS_POLY_EVAL_5_HPP

namespace boost{ namespace math{ namespace tools{ namespace detail{

template <class T, class V>
inline V evaluate_polynomial_c_imp(const T*, const V&, const mpl::int_<0>*) BOOST_MATH_NOEXCEPT(V)
{
   return static_cast<V>(0);
}

template <class T, class V>
inline V evaluate_polynomial_c_imp(const T* a, const V&, const mpl::int_<1>*) BOOST_MATH_NOEXCEPT(V)
{
   return static_cast<V>(a[0]);
}

template <class T, class V>
inline V evaluate_polynomial_c_imp(const T* a, const V& x, const mpl::int_<2>*) BOOST_MATH_NOEXCEPT(V)
{
   return static_cast<V>(a[1] * x + a[0]);
}

template <class T, class V>
inline V evaluate_polynomial_c_imp(const T* a, const V& x, const mpl::int_<3>*) BOOST_MATH_NOEXCEPT(V)
{
   return static_cast<V>((a[2] * x + a[1]) * x + a[0]);
}

template <class T, class V>
inline V evaluate_polynomial_c_imp(const T* a, const V& x, const mpl::int_<4>*) BOOST_MATH_NOEXCEPT(V)
{
   return static_cast<V>(((a[3] * x + a[2]) * x + a[1]) * x + a[0]);
}

template <class T, class V>
inline V evaluate_polynomial_c_imp(const T* a, const V& x, const mpl::int_<5>*) BOOST_MATH_NOEXCEPT(V)
{
   V x2 = x * x;
   return static_cast<V>((a[4] * x2 + a[2]) * x2 + a[0] + (a[3] * x2 + a[1]) * x);
}

}}}} // namespaces

#endif // include guard


code:
/*
Copyright Charly Chevalier 2015
Copyright Joel Falcou 2015
Distributed under the Boost Software License, Version 1.0.
(See accompanying file LICENSE_1_0.txt or copy at
http://www.boost.org/LICENSE_1_0.txt)
*/

#ifndef BOOST_PREDEF_HARDWARE_SIMD_X86_AMD_VERSIONS_H
#define BOOST_PREDEF_HARDWARE_SIMD_X86_AMD_VERSIONS_H

#include <boost/predef/version_number.h>

/*`
 Those defines represent x86 (AMD specific) SIMD extensions versions.

 [note You *MUST* compare them with the predef `BOOST_HW_SIMD_X86_AMD`.]
 */

// ---------------------------------

/*`
 [heading `BOOST_HW_SIMD_X86_AMD_SSE4A_VERSION`]

 [@https://en.wikipedia.org/wiki/SSE4##SSE4A SSE4A] x86 extension (AMD specific).

 Version number is: *4.0.0*.
 */
#define BOOST_HW_SIMD_X86_AMD_SSE4A_VERSION BOOST_VERSION_NUMBER(4, 0, 0)

/*`
 [heading `BOOST_HW_SIMD_X86_AMD_FMA4_VERSION`]

 [@https://en.wikipedia.org/wiki/FMA_instruction_set#FMA4_instruction_set FMA4] x86 extension (AMD specific).

 Version number is: *5.1.0*.
 */
#define BOOST_HW_SIMD_X86_AMD_FMA4_VERSION BOOST_VERSION_NUMBER(5, 1, 0)

/*`
 [heading `BOOST_HW_SIMD_X86_AMD_XOP_VERSION`]

 [@https://en.wikipedia.org/wiki/XOP_instruction_set XOP] x86 extension (AMD specific).

 Version number is: *5.1.1*.
 */
#define BOOST_HW_SIMD_X86_AMD_XOP_VERSION BOOST_VERSION_NUMBER(5, 1, 1)

#endif


code:
/*=============================================================================
    Copyright (c) 2001-2011 Joel de Guzman

    Distributed under the Boost Software License, Version 1.0. (See accompanying
    file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)

    This is an auto-generated file. Do not edit!
==============================================================================*/
namespace boost { namespace fusion
{
    struct nil_;
    struct void_;
    template <typename T0 , typename T1 , typename T2 , typename T3 , typename T4 , typename T5 , typename T6 , typename T7 , typename T8 , typename T9 , typename T10 , typename T11 , typename T12 , typename T13 , typename T14 , typename T15 , typename T16 , typename T17 , typename T18 , typename T19>
    struct list
        : detail::list_to_cons<T0 , T1 , T2 , T3 , T4 , T5 , T6 , T7 , T8 , T9 , T10 , T11 , T12 , T13 , T14 , T15 , T16 , T17 , T18 , T19>::type
    {
    private:
        typedef
            detail::list_to_cons<T0 , T1 , T2 , T3 , T4 , T5 , T6 , T7 , T8 , T9 , T10 , T11 , T12 , T13 , T14 , T15 , T16 , T17 , T18 , T19>
        list_to_cons;
        typedef typename list_to_cons::type inherited_type;
    public:
        BOOST_CONSTEXPR BOOST_FUSION_GPU_ENABLED
        list()
            : inherited_type() {}
        template <typename U0 , typename U1 , typename U2 , typename U3 , typename U4 , typename U5 , typename U6 , typename U7 , typename U8 , typename U9 , typename U10 , typename U11 , typename U12 , typename U13 , typename U14 , typename U15 , typename U16 , typename U17 , typename U18 , typename U19>
        BOOST_CONSTEXPR BOOST_FUSION_GPU_ENABLED
        list(list<U0 , U1 , U2 , U3 , U4 , U5 , U6 , U7 , U8 , U9 , U10 , U11 , U12 , U13 , U14 , U15 , U16 , U17 , U18 , U19> const& rhs)
            : inherited_type(rhs) {}
        template <typename Sequence>
        BOOST_FUSION_GPU_ENABLED
        list(Sequence const& rhs
            , typename enable_if<traits::is_sequence<Sequence>, detail::enabler_>::type = detail::enabler)
            : inherited_type(rhs) {}

    BOOST_CONSTEXPR BOOST_FUSION_GPU_ENABLED
    explicit
    list(typename detail::call_param<T0 >::type arg0)
        : inherited_type(list_to_cons::call(arg0))
    {}
    BOOST_CONSTEXPR BOOST_FUSION_GPU_ENABLED
    list(typename detail::call_param<T0 >::type arg0 , typename detail::call_param<T1 >::type arg1)
        : inherited_type(list_to_cons::call(arg0 , arg1))
    {}
    BOOST_CONSTEXPR BOOST_FUSION_GPU_ENABLED
    list(typename detail::call_param<T0 >::type arg0 , typename detail::call_param<T1 >::type arg1 , typename detail::call_param<T2 >::type arg2)
        : inherited_type(list_to_cons::call(arg0 , arg1 , arg2))
    {}
    BOOST_CONSTEXPR BOOST_FUSION_GPU_ENABLED
    list(typename detail::call_param<T0 >::type arg0 , typename detail::call_param<T1 >::type arg1 , typename detail::call_param<T2 >::type arg2 , typename detail::call_param<T3 >::type arg3)
        : inherited_type(list_to_cons::call(arg0 , arg1 , arg2 , arg3))
    {}
    BOOST_CONSTEXPR BOOST_FUSION_GPU_ENABLED
    list(typename detail::call_param<T0 >::type arg0 , typename detail::call_param<T1 >::type arg1 , typename detail::call_param<T2 >::type arg2 , typename detail::call_param<T3 >::type arg3 , typename detail::call_param<T4 >::type arg4)
        : inherited_type(list_to_cons::call(arg0 , arg1 , arg2 , arg3 , arg4))
    {}
    BOOST_CONSTEXPR BOOST_FUSION_GPU_ENABLED
    list(typename detail::call_param<T0 >::type arg0 , typename detail::call_param<T1 >::type arg1 , typename detail::call_param<T2 >::type arg2 , typename detail::call_param<T3 >::type arg3 , typename detail::call_param<T4 >::type arg4 , typename detail::call_param<T5 >::type arg5)
        : inherited_type(list_to_cons::call(arg0 , arg1 , arg2 , arg3 , arg4 , arg5))
    {}
    BOOST_CONSTEXPR BOOST_FUSION_GPU_ENABLED
    list(typename detail::call_param<T0 >::type arg0 , typename detail::call_param<T1 >::type arg1 , typename detail::call_param<T2 >::type arg2 , typename detail::call_param<T3 >::type arg3 , typename detail::call_param<T4 >::type arg4 , typename detail::call_param<T5 >::type arg5 , typename detail::call_param<T6 >::type arg6)
        : inherited_type(list_to_cons::call(arg0 , arg1 , arg2 , arg3 , arg4 , arg5 , arg6))
    {}
    BOOST_CONSTEXPR BOOST_FUSION_GPU_ENABLED
    list(typename detail::call_param<T0 >::type arg0 , typename detail::call_param<T1 >::type arg1 , typename detail::call_param<T2 >::type arg2 , typename detail::call_param<T3 >::type arg3 , typename detail::call_param<T4 >::type arg4 , typename detail::call_param<T5 >::type arg5 , typename detail::call_param<T6 >::type arg6 , typename detail::call_param<T7 >::type arg7)
        : inherited_type(list_to_cons::call(arg0 , arg1 , arg2 , arg3 , arg4 , arg5 , arg6 , arg7))
    {}
    BOOST_CONSTEXPR BOOST_FUSION_GPU_ENABLED
    list(typename detail::call_param<T0 >::type arg0 , typename detail::call_param<T1 >::type arg1 , typename detail::call_param<T2 >::type arg2 , typename detail::call_param<T3 >::type arg3 , typename detail::call_param<T4 >::type arg4 , typename detail::call_param<T5 >::type arg5 , typename detail::call_param<T6 >::type arg6 , typename detail::call_param<T7 >::type arg7 , typename detail::call_param<T8 >::type arg8)
        : inherited_type(list_to_cons::call(arg0 , arg1 , arg2 , arg3 , arg4 , arg5 , arg6 , arg7 , arg8))
    {}
    BOOST_CONSTEXPR BOOST_FUSION_GPU_ENABLED
    list(typename detail::call_param<T0 >::type arg0 , typename detail::call_param<T1 >::type arg1 , typename detail::call_param<T2 >::type arg2 , typename detail::call_param<T3 >::type arg3 , typename detail::call_param<T4 >::type arg4 , typename detail::call_param<T5 >::type arg5 , typename detail::call_param<T6 >::type arg6 , typename detail::call_param<T7 >::type arg7 , typename detail::call_param<T8 >::type arg8 , typename detail::call_param<T9 >::type arg9)
        : inherited_type(list_to_cons::call(arg0 , arg1 , arg2 , arg3 , arg4 , arg5 , arg6 , arg7 , arg8 , arg9))
    {}
    BOOST_CONSTEXPR BOOST_FUSION_GPU_ENABLED
    list(typename detail::call_param<T0 >::type arg0 , typename detail::call_param<T1 >::type arg1 , typename detail::call_param<T2 >::type arg2 , typename detail::call_param<T3 >::type arg3 , typename detail::call_param<T4 >::type arg4 , typename detail::call_param<T5 >::type arg5 , typename detail::call_param<T6 >::type arg6 , typename detail::call_param<T7 >::type arg7 , typename detail::call_param<T8 >::type arg8 , typename detail::call_param<T9 >::type arg9 , typename detail::call_param<T10 >::type arg10)
        : inherited_type(list_to_cons::call(arg0 , arg1 , arg2 , arg3 , arg4 , arg5 , arg6 , arg7 , arg8 , arg9 , arg10))
    {}
    BOOST_CONSTEXPR BOOST_FUSION_GPU_ENABLED
    list(typename detail::call_param<T0 >::type arg0 , typename detail::call_param<T1 >::type arg1 , typename detail::call_param<T2 >::type arg2 , typename detail::call_param<T3 >::type arg3 , typename detail::call_param<T4 >::type arg4 , typename detail::call_param<T5 >::type arg5 , typename detail::call_param<T6 >::type arg6 , typename detail::call_param<T7 >::type arg7 , typename detail::call_param<T8 >::type arg8 , typename detail::call_param<T9 >::type arg9 , typename detail::call_param<T10 >::type arg10 , typename detail::call_param<T11 >::type arg11)
        : inherited_type(list_to_cons::call(arg0 , arg1 , arg2 , arg3 , arg4 , arg5 , arg6 , arg7 , arg8 , arg9 , arg10 , arg11))
    {}
    BOOST_CONSTEXPR BOOST_FUSION_GPU_ENABLED
    list(typename detail::call_param<T0 >::type arg0 , typename detail::call_param<T1 >::type arg1 , typename detail::call_param<T2 >::type arg2 , typename detail::call_param<T3 >::type arg3 , typename detail::call_param<T4 >::type arg4 , typename detail::call_param<T5 >::type arg5 , typename detail::call_param<T6 >::type arg6 , typename detail::call_param<T7 >::type arg7 , typename detail::call_param<T8 >::type arg8 , typename detail::call_param<T9 >::type arg9 , typename detail::call_param<T10 >::type arg10 , typename detail::call_param<T11 >::type arg11 , typename detail::call_param<T12 >::type arg12)
        : inherited_type(list_to_cons::call(arg0 , arg1 , arg2 , arg3 , arg4 , arg5 , arg6 , arg7 , arg8 , arg9 , arg10 , arg11 , arg12))
    {}
    BOOST_CONSTEXPR BOOST_FUSION_GPU_ENABLED
    list(typename detail::call_param<T0 >::type arg0 , typename detail::call_param<T1 >::type arg1 , typename detail::call_param<T2 >::type arg2 , typename detail::call_param<T3 >::type arg3 , typename detail::call_param<T4 >::type arg4 , typename detail::call_param<T5 >::type arg5 , typename detail::call_param<T6 >::type arg6 , typename detail::call_param<T7 >::type arg7 , typename detail::call_param<T8 >::type arg8 , typename detail::call_param<T9 >::type arg9 , typename detail::call_param<T10 >::type arg10 , typename detail::call_param<T11 >::type arg11 , typename detail::call_param<T12 >::type arg12 , typename detail::call_param<T13 >::type arg13)
        : inherited_type(list_to_cons::call(arg0 , arg1 , arg2 , arg3 , arg4 , arg5 , arg6 , arg7 , arg8 , arg9 , arg10 , arg11 , arg12 , arg13))
    {}
    BOOST_CONSTEXPR BOOST_FUSION_GPU_ENABLED
    list(typename detail::call_param<T0 >::type arg0 , typename detail::call_param<T1 >::type arg1 , typename detail::call_param<T2 >::type arg2 , typename detail::call_param<T3 >::type arg3 , typename detail::call_param<T4 >::type arg4 , typename detail::call_param<T5 >::type arg5 , typename detail::call_param<T6 >::type arg6 , typename detail::call_param<T7 >::type arg7 , typename detail::call_param<T8 >::type arg8 , typename detail::call_param<T9 >::type arg9 , typename detail::call_param<T10 >::type arg10 , typename detail::call_param<T11 >::type arg11 , typename detail::call_param<T12 >::type arg12 , typename detail::call_param<T13 >::type arg13 , typename detail::call_param<T14 >::type arg14)
        : inherited_type(list_to_cons::call(arg0 , arg1 , arg2 , arg3 , arg4 , arg5 , arg6 , arg7 , arg8 , arg9 , arg10 , arg11 , arg12 , arg13 , arg14))
    {}
    BOOST_CONSTEXPR BOOST_FUSION_GPU_ENABLED
    list(typename detail::call_param<T0 >::type arg0 , typename detail::call_param<T1 >::type arg1 , typename detail::call_param<T2 >::type arg2 , typename detail::call_param<T3 >::type arg3 , typename detail::call_param<T4 >::type arg4 , typename detail::call_param<T5 >::type arg5 , typename detail::call_param<T6 >::type arg6 , typename detail::call_param<T7 >::type arg7 , typename detail::call_param<T8 >::type arg8 , typename detail::call_param<T9 >::type arg9 , typename detail::call_param<T10 >::type arg10 , typename detail::call_param<T11 >::type arg11 , typename detail::call_param<T12 >::type arg12 , typename detail::call_param<T13 >::type arg13 , typename detail::call_param<T14 >::type arg14 , typename detail::call_param<T15 >::type arg15)
        : inherited_type(list_to_cons::call(arg0 , arg1 , arg2 , arg3 , arg4 , arg5 , arg6 , arg7 , arg8 , arg9 , arg10 , arg11 , arg12 , arg13 , arg14 , arg15))
    {}
    BOOST_CONSTEXPR BOOST_FUSION_GPU_ENABLED
    list(typename detail::call_param<T0 >::type arg0 , typename detail::call_param<T1 >::type arg1 , typename detail::call_param<T2 >::type arg2 , typename detail::call_param<T3 >::type arg3 , typename detail::call_param<T4 >::type arg4 , typename detail::call_param<T5 >::type arg5 , typename detail::call_param<T6 >::type arg6 , typename detail::call_param<T7 >::type arg7 , typename detail::call_param<T8 >::type arg8 , typename detail::call_param<T9 >::type arg9 , typename detail::call_param<T10 >::type arg10 , typename detail::call_param<T11 >::type arg11 , typename detail::call_param<T12 >::type arg12 , typename detail::call_param<T13 >::type arg13 , typename detail::call_param<T14 >::type arg14 , typename detail::call_param<T15 >::type arg15 , typename detail::call_param<T16 >::type arg16)
        : inherited_type(list_to_cons::call(arg0 , arg1 , arg2 , arg3 , arg4 , arg5 , arg6 , arg7 , arg8 , arg9 , arg10 , arg11 , arg12 , arg13 , arg14 , arg15 , arg16))
    {}
    BOOST_CONSTEXPR BOOST_FUSION_GPU_ENABLED
    list(typename detail::call_param<T0 >::type arg0 , typename detail::call_param<T1 >::type arg1 , typename detail::call_param<T2 >::type arg2 , typename detail::call_param<T3 >::type arg3 , typename detail::call_param<T4 >::type arg4 , typename detail::call_param<T5 >::type arg5 , typename detail::call_param<T6 >::type arg6 , typename detail::call_param<T7 >::type arg7 , typename detail::call_param<T8 >::type arg8 , typename detail::call_param<T9 >::type arg9 , typename detail::call_param<T10 >::type arg10 , typename detail::call_param<T11 >::type arg11 , typename detail::call_param<T12 >::type arg12 , typename detail::call_param<T13 >::type arg13 , typename detail::call_param<T14 >::type arg14 , typename detail::call_param<T15 >::type arg15 , typename detail::call_param<T16 >::type arg16 , typename detail::call_param<T17 >::type arg17)
        : inherited_type(list_to_cons::call(arg0 , arg1 , arg2 , arg3 , arg4 , arg5 , arg6 , arg7 , arg8 , arg9 , arg10 , arg11 , arg12 , arg13 , arg14 , arg15 , arg16 , arg17))
    {}
    BOOST_CONSTEXPR BOOST_FUSION_GPU_ENABLED
    list(typename detail::call_param<T0 >::type arg0 , typename detail::call_param<T1 >::type arg1 , typename detail::call_param<T2 >::type arg2 , typename detail::call_param<T3 >::type arg3 , typename detail::call_param<T4 >::type arg4 , typename detail::call_param<T5 >::type arg5 , typename detail::call_param<T6 >::type arg6 , typename detail::call_param<T7 >::type arg7 , typename detail::call_param<T8 >::type arg8 , typename detail::call_param<T9 >::type arg9 , typename detail::call_param<T10 >::type arg10 , typename detail::call_param<T11 >::type arg11 , typename detail::call_param<T12 >::type arg12 , typename detail::call_param<T13 >::type arg13 , typename detail::call_param<T14 >::type arg14 , typename detail::call_param<T15 >::type arg15 , typename detail::call_param<T16 >::type arg16 , typename detail::call_param<T17 >::type arg17 , typename detail::call_param<T18 >::type arg18)
        : inherited_type(list_to_cons::call(arg0 , arg1 , arg2 , arg3 , arg4 , arg5 , arg6 , arg7 , arg8 , arg9 , arg10 , arg11 , arg12 , arg13 , arg14 , arg15 , arg16 , arg17 , arg18))
    {}
    BOOST_CONSTEXPR BOOST_FUSION_GPU_ENABLED
    list(typename detail::call_param<T0 >::type arg0 , typename detail::call_param<T1 >::type arg1 , typename detail::call_param<T2 >::type arg2 , typename detail::call_param<T3 >::type arg3 , typename detail::call_param<T4 >::type arg4 , typename detail::call_param<T5 >::type arg5 , typename detail::call_param<T6 >::type arg6 , typename detail::call_param<T7 >::type arg7 , typename detail::call_param<T8 >::type arg8 , typename detail::call_param<T9 >::type arg9 , typename detail::call_param<T10 >::type arg10 , typename detail::call_param<T11 >::type arg11 , typename detail::call_param<T12 >::type arg12 , typename detail::call_param<T13 >::type arg13 , typename detail::call_param<T14 >::type arg14 , typename detail::call_param<T15 >::type arg15 , typename detail::call_param<T16 >::type arg16 , typename detail::call_param<T17 >::type arg17 , typename detail::call_param<T18 >::type arg18 , typename detail::call_param<T19 >::type arg19)
        : inherited_type(list_to_cons::call(arg0 , arg1 , arg2 , arg3 , arg4 , arg5 , arg6 , arg7 , arg8 , arg9 , arg10 , arg11 , arg12 , arg13 , arg14 , arg15 , arg16 , arg17 , arg18 , arg19))
    {}
        template <typename U0 , typename U1 , typename U2 , typename U3 , typename U4 , typename U5 , typename U6 , typename U7 , typename U8 , typename U9 , typename U10 , typename U11 , typename U12 , typename U13 , typename U14 , typename U15 , typename U16 , typename U17 , typename U18 , typename U19>
        BOOST_CXX14_CONSTEXPR BOOST_FUSION_GPU_ENABLED
        list&
        operator=(list<U0 , U1 , U2 , U3 , U4 , U5 , U6 , U7 , U8 , U9 , U10 , U11 , U12 , U13 , U14 , U15 , U16 , U17 , U18 , U19> const& rhs)
        {
            inherited_type::operator=(rhs);
            return *this;
        }
        template <typename Sequence>
        BOOST_CXX14_CONSTEXPR BOOST_FUSION_GPU_ENABLED
        typename boost::enable_if<traits::is_sequence<Sequence>, list&>::type
        operator=(Sequence const& rhs)
        {
            inherited_type::operator=(rhs);
            return *this;
        }
    };
}}


code:
// Copyright David Abrahams 2002.
// Distributed under the Boost Software License, Version 1.0. (See
// accompanying file LICENSE_1_0.txt or copy at
// http://www.boost.org/LICENSE_1_0.txt)
#ifndef CONSTRUCT_REFERENCE_DWA2002716_HPP
# define CONSTRUCT_REFERENCE_DWA2002716_HPP

namespace boost { namespace python { namespace detail {

template <class T, class Arg>
void construct_pointee(void* storage, Arg& x, T const volatile*)
{
    new (storage) T(x);
}

template <class T, class Arg>
void construct_referent_impl(void* storage, Arg& x, T&(*)())
{
    construct_pointee(storage, x, (T*)0);
}

template <class T, class Arg>
void construct_referent(void* storage, Arg const& x, T(*tag)() = 0)
{
    construct_referent_impl(storage, x, tag);
}

template <class T, class Arg>
void construct_referent(void* storage, Arg& x, T(*tag)() = 0)
{
    construct_referent_impl(storage, x, tag);
}

}}} // namespace boost::python::detail

#endif // CONSTRUCT_REFERENCE_DWA2002716_HPP


code:
#ifndef BOOST_MPL_VALUE_TYPE_FWD_HPP_INCLUDED
#define BOOST_MPL_VALUE_TYPE_FWD_HPP_INCLUDED

// Copyright Aleksey Gurtovoy 2003-2004
// Copyright David Abrahams 2003-2004
//
// Distributed under the Boost Software License, Version 1.0.
// (See accompanying file LICENSE_1_0.txt or copy at
// http://www.boost.org/LICENSE_1_0.txt)
//
// See http://www.boost.org/libs/mpl for documentation.

// $Id$
// $Date$
// $Revision$

namespace boost { namespace mpl {

template< typename Tag > struct value_type_impl;
template< typename AssociativeSequence, typename T > struct value_type;

}}

#endif // BOOST_MPL_VALUE_TYPE_FWD_HPP_INCLUDED