      BLOCK DATA DT_BLKD43

C***********************************************************************
C                                                                      *
C     Created on 10 december 1991  by    Alfredo Ferrari & Paola Sala  *
C                                                   Infn - Milan       *
C                                                                      *
C     Last change on 18-dec-2012   by    S.Roesler                     *
C                                                                      *
C     This is the original common reac of Hadrin                       *
C                                                                      *
C***********************************************************************

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      SAVE
C
      INCLUDE 'inc/hnreac'

      DIMENSION UMOpi(92) , UMOkc(68) , UMOp(39) , UMOn(63) , UMOk0(34)
     &          , PLApi(92) , PLAkc(68) , PLAp(39) , PLAn(63) ,
     &          PLAk0(34) , SPIkp1(315) , SPIkpu(278) , SPIkpv(372) ,
     &          SPIkpw(278) , SPIkpx(372) , SPIkp4(315) , SPIkp5(187) ,
     &          SPIkp6(289) , SKMpel(102) , SPIkp7(289) , SKMnel(68) ,
     &          SPIkp8(187) , SPIkp9(143) , SPIkp0(169) , SPKpv(143) ,
     &          SAPpel(105) , SPIkpe(399) , SAPnel(84) , SPIkpz(273) ,
     &          SANpel(84) , SPIkpf(273) , SPKp15(187) , SPKp16(272) ,
     &          NRKpi(164) , NRKkc(132) , NRKp(70) , NRKn(116) ,
     &          NRKk0(54) , NUReln(60)
C
      DIMENSION NRKlin(532)
      EQUIVALENCE (NRK(1,1),NRKlin(1))
      EQUIVALENCE (UMO(1),UMOpi(1))
      EQUIVALENCE (UMO(93),UMOkc(1))
      EQUIVALENCE (UMO(161),UMOp(1))
      EQUIVALENCE (UMO(200),UMOn(1))
      EQUIVALENCE (UMO(263),UMOk0(1))
      EQUIVALENCE (PLAbf(1),PLApi(1))
      EQUIVALENCE (PLAbf(93),PLAkc(1))
      EQUIVALENCE (PLAbf(161),PLAp(1))
      EQUIVALENCE (PLAbf(200),PLAn(1))
      EQUIVALENCE (PLAbf(263),PLAk0(1))
      EQUIVALENCE (WK(1),SPIkp1(1))
      EQUIVALENCE (WK(316),SPIkpu(1))
      EQUIVALENCE (WK(594),SPIkpv(1))
      EQUIVALENCE (WK(966),SPIkpw(1))
      EQUIVALENCE (WK(1244),SPIkpx(1))
      EQUIVALENCE (WK(1616),SPIkp4(1))
      EQUIVALENCE (WK(1931),SPIkp5(1))
      EQUIVALENCE (WK(2118),SPIkp6(1))
      EQUIVALENCE (WK(2407),SKMpel(1))
      EQUIVALENCE (WK(2509),SPIkp7(1))
      EQUIVALENCE (WK(2798),SKMnel(1))
      EQUIVALENCE (WK(2866),SPIkp8(1))
      EQUIVALENCE (WK(3053),SPIkp9(1))
      EQUIVALENCE (WK(3196),SPIkp0(1))
      EQUIVALENCE (WK(3365),SPKpv(1))
      EQUIVALENCE (WK(3508),SAPpel(1))
      EQUIVALENCE (WK(3613),SPIkpe(1))
      EQUIVALENCE (WK(4012),SAPnel(1))
      EQUIVALENCE (WK(4096),SPIkpz(1))
      EQUIVALENCE (WK(4369),SANpel(1))
      EQUIVALENCE (WK(4453),SPIkpf(1))
      EQUIVALENCE (WK(4726),SPKp15(1))
      EQUIVALENCE (WK(4913),SPKp16(1))
      EQUIVALENCE (NRK(1,1),NRKlin(1))
      EQUIVALENCE (NRKlin(1),NRKpi(1))
      EQUIVALENCE (NRKlin(165),NRKkc(1))
      EQUIVALENCE (NRKlin(297),NRKp(1))
      EQUIVALENCE (NRKlin(367),NRKn(1))
      EQUIVALENCE (NRKlin(483),NRKk0(1))
      EQUIVALENCE (NURe(1,1),NUReln(1))
C
      DATA PLApi/0.D0 , .3D0 , .5D0 , .6D0 , .7D0 , .8D0 , .9D0 ,
     &     .95D0 , 1.D0 , 1.15D0 , 1.3D0 , 1.5D0 , 1.6D0 , 1.8D0 ,
     &     2.D0 , 2.3D0 , 2.5D0 , 2.8D0 , 3.D0 , 3.5D0 , 4.D0 , 0.D0 ,
     &     .285D0 , .4D0 , .45D0 , .5D0 , .6D0 , .7D0 , .75D0 , .8D0 ,
     &     .85D0 , .9D0 , 1.D0 , 1.15D0 , 1.3D0 , 1.5D0 , 1.6D0 ,
     &     1.8D0 , 2.D0 , 2.3D0 , 2.5D0 , 2.8D0 , 3.D0 , 3.5D0 , 4.D0 ,
     &     4.5D0 , 0.D0 , .285D0 , .4D0 , .45D0 , .5D0 , .6D0 , .7D0 ,
     &     .75D0 , .8D0 , .85D0 , .9D0 , 1.D0 , 1.15D0 , 1.3D0 , 1.5D0 ,
     &     1.6D0 , 1.8D0 , 2.D0 , 2.3D0 , 2.5D0 , 2.8D0 , 3.D0 , 3.5D0 ,
     &     4.D0 , 4.5D0 , 0.D0 , .3D0 , .5D0 , .6D0 , .7D0 , .8D0 ,
     &     .9D0 , .95D0 , 1.D0 , 1.15D0 , 1.3D0 , 1.5D0 , 1.6D0 ,
     &     1.8D0 , 2.D0 , 2.3D0 , 2.5D0 , 2.8D0 , 3.D0 , 3.5D0 , 4.D0/
      DATA PLAkc/0.D0 , .58D0 , .8D0 , 1.01D0 , 1.23D0 , 1.45D0 ,
     &     1.68D0 , 1.94D0 , 2.18D0 , 2.42D0 , 2.68D0 , 2.96D0 ,
     &     3.24D0 , 3.51D0 , 3.84D0 , 4.16D0 , 4.49D0 , 0.D0 , .58D0 ,
     &     .8D0 , 1.01D0 , 1.23D0 , 1.45D0 , 1.68D0 , 1.94D0 , 2.18D0 ,
     &     2.42D0 , 2.68D0 , 2.96D0 , 3.24D0 , 3.51D0 , 3.84D0 ,
     &     4.16D0 , 4.49D0 , 0.D0 , .58D0 , .8D0 , 1.01D0 , 1.23D0 ,
     &     1.45D0 , 1.68D0 , 1.94D0 , 2.18D0 , 2.42D0 , 2.68D0 ,
     &     2.96D0 , 3.24D0 , 3.51D0 , 3.84D0 , 4.16D0 , 4.49D0 , 0.D0 ,
     &     .58D0 , .8D0 , 1.01D0 , 1.23D0 , 1.45D0 , 1.68D0 , 1.94D0 ,
     &     2.18D0 , 2.42D0 , 2.68D0 , 2.96D0 , 3.24D0 , 3.51D0 ,
     &     3.84D0 , 4.16D0 , 4.49D0/
      DATA PLAk0/0.D0 , .58D0 , .8D0 , 1.01D0 , 1.23D0 , 1.45D0 ,
     &     1.68D0 , 1.94D0 , 2.18D0 , 2.42D0 , 2.68D0 , 2.96D0 ,
     &     3.24D0 , 3.51D0 , 3.84D0 , 4.16D0 , 4.49D0 , 0.D0 , .58D0 ,
     &     .8D0 , 1.01D0 , 1.23D0 , 1.45D0 , 1.68D0 , 1.94D0 , 2.18D0 ,
     &     2.42D0 , 2.68D0 , 2.96D0 , 3.24D0 , 3.51D0 , 3.84D0 ,
     &     4.16D0 , 4.49D0/
C                 pp   pn   np   nn                                    *
      DATA PLAp/0.D0 , 1.06D0 , 1.34D0 , 1.63D0 , 1.92D0 , 2.2D0 ,
     &     2.5D0 , 2.8D0 , 3.1D0 , 3.43D0 , 3.75D0 , 4.07D0 , 4.43D0 ,
     &     0.D0 , 1.06D0 , 1.34D0 , 1.63D0 , 1.92D0 , 2.2D0 , 2.5D0 ,
     &     2.8D0 , 3.1D0 , 3.43D0 , 3.75D0 , 4.07D0 , 4.43D0 , 0.D0 ,
     &     1.06D0 , 1.34D0 , 1.63D0 , 1.92D0 , 2.2D0 , 2.5D0 , 2.8D0 ,
     &     3.1D0 , 3.43D0 , 3.75D0 , 4.07D0 , 4.43D0/
C    app   apn   anp   ann                                             *
      DATA PLAn/0.D0 , 1.D-3 , .1D0 , .2D0 , .3D0 , .4D0 , .5D0 , .6D0 ,
     &     .74D0 , 1.06D0 , 1.34D0 , 1.63D0 , 1.92D0 , 2.2D0 , 2.5D0 ,
     &     2.8D0 , 3.1D0 , 3.43D0 , 3.75D0 , 4.07D0 , 4.43D0 , 0.D0 ,
     &     1.D-3 , .1D0 , .2D0 , .3D0 , .4D0 , .5D0 , .6D0 , .74D0 ,
     &     1.06D0 , 1.34D0 , 1.63D0 , 1.92D0 , 2.2D0 , 2.5D0 , 2.8D0 ,
     &     3.1D0 , 3.43D0 , 3.75D0 , 4.07D0 , 4.43D0 , 0.D0 , 1.D-3 ,
     &     .1D0 , .2D0 , .3D0 , .4D0 , .5D0 , .6D0 , .74D0 , 1.06D0 ,
     &     1.34D0 , 1.63D0 , 1.92D0 , 2.2D0 , 2.5D0 , 2.8D0 , 3.1D0 ,
     &     3.43D0 , 3.75D0 , 4.07D0 , 4.43D0/
      DATA SIIn/296*0.D0/
      DATA UMOpi/1.08D0 , 1.233D0 , 1.302D0 , 1.369D0 , 1.496D0 ,
     &     1.557D0 , 1.615D0 , 1.6435D0 , 1.672D0 , 1.753D0 , 1.831D0 ,
     &     1.930D0 , 1.978D0 , 2.071D0 , 2.159D0 , 2.286D0 , 2.366D0 ,
     &     2.482D0 , 2.56D0 , 2.735D0 , 2.90D0 , 1.08D0 , 1.222D0 ,
     &     1.302D0 , 1.3365D0 , 1.369D0 , 1.434D0 , 1.496D0 , 1.527D0 ,
     &     1.557D0 , 1.586D0 , 1.615D0 , 1.672D0 , 1.753D0 , 1.831D0 ,
     &     1.930D0 , 1.978D0 , 2.071D0 , 2.159D0 , 2.286D0 , 2.366D0 ,
     &     2.482D0 , 2.560D0 , 2.735D0 , 2.90D0 , 3.06D0 , 1.08D0 ,
     &     1.222D0 , 1.302D0 , 1.3365D0 , 1.369D0 , 1.434D0 , 1.496D0 ,
     &     1.527D0 , 1.557D0 , 1.586D0 , 1.615D0 , 1.672D0 , 1.753D0 ,
     &     1.831D0 , 1.930D0 , 1.978D0 , 2.071D0 , 2.159D0 , 2.286D0 ,
     &     2.366D0 , 2.482D0 , 2.560D0 , 2.735D0 , 2.90D0 , 3.06D0 ,
     &     1.08D0 , 1.233D0 , 1.302D0 , 1.369D0 , 1.496D0 , 1.557D0 ,
     &     1.615D0 , 1.6435D0 , 1.672D0 , 1.753D0 , 1.831D0 , 1.930D0 ,
     &     1.978D0 , 2.071D0 , 2.159D0 , 2.286D0 , 2.366D0 , 2.482D0 ,
     &     2.56D0 , 2.735D0 , 2.90D0/
      DATA UMOkc/1.44D0 , 1.598D0 , 1.7D0 , 1.8D0 , 1.9D0 , 2.0D0 ,
     &     2.1D0 , 2.2D0 , 2.3D0 , 2.4D0 , 2.5D0 , 2.6D0 , 2.7D0 ,
     &     2.8D0 , 2.9D0 , 3.0D0 , 3.1D0 , 1.44D0 , 1.598D0 , 1.7D0 ,
     &     1.8D0 , 1.9D0 , 2.0D0 , 2.1D0 , 2.2D0 , 2.3D0 , 2.4D0 ,
     &     2.5D0 , 2.6D0 , 2.7D0 , 2.8D0 , 2.9D0 , 3.0D0 , 3.1D0 ,
     &     1.44D0 , 1.598D0 , 1.7D0 , 1.8D0 , 1.9D0 , 2.0D0 , 2.1D0 ,
     &     2.2D0 , 2.3D0 , 2.4D0 , 2.5D0 , 2.6D0 , 2.7D0 , 2.8D0 ,
     &     2.9D0 , 3.0D0 , 3.1D0 , 1.44D0 , 1.598D0 , 1.7D0 , 1.8D0 ,
     &     1.9D0 , 2.0D0 , 2.1D0 , 2.2D0 , 2.3D0 , 2.4D0 , 2.5D0 ,
     &     2.6D0 , 2.7D0 , 2.8D0 , 2.9D0 , 3.0D0 , 3.1D0/
      DATA UMOk0/1.44D0 , 1.598D0 , 1.7D0 , 1.8D0 , 1.9D0 , 2.0D0 ,
     &     2.1D0 , 2.2D0 , 2.3D0 , 2.4D0 , 2.5D0 , 2.6D0 , 2.7D0 ,
     &     2.8D0 , 2.9D0 , 3.0D0 , 3.1D0 , 1.44D0 , 1.598D0 , 1.7D0 ,
     &     1.8D0 , 1.9D0 , 2.0D0 , 2.1D0 , 2.2D0 , 2.3D0 , 2.4D0 ,
     &     2.5D0 , 2.6D0 , 2.7D0 , 2.8D0 , 2.9D0 , 3.0D0 , 3.1D0/
C                 pp   pn   np   nn                                    *
      DATA UMOp/1.88D0 , 2.102D0 , 2.2D0 , 2.3D0 , 2.4D0 , 2.5D0 ,
     &     2.6D0 , 2.7D0 , 2.8D0 , 2.9D0 , 3.D0 , 3.1D0 , 3.2D0 ,
     &     1.88D0 , 2.102D0 , 2.2D0 , 2.3D0 , 2.4D0 , 2.5D0 , 2.6D0 ,
     &     2.7D0 , 2.8D0 , 2.9D0 , 3.D0 , 3.1D0 , 3.2D0 , 1.88D0 ,
     &     2.102D0 , 2.2D0 , 2.3D0 , 2.4D0 , 2.5D0 , 2.6D0 , 2.7D0 ,
     &     2.8D0 , 2.9D0 , 3.D0 , 3.1D0 , 3.2D0/
C    app   apn   anp   ann                                             *
      DATA UMOn/1.877D0 , 1.87701D0 , 1.879D0 , 1.887D0 , 1.9D0 ,
     &     1.917D0 , 1.938D0 , 1.962D0 , 2.D0 , 2.102D0 , 2.2D0 ,
     &     2.3D0 , 2.4D0 , 2.5D0 , 2.6D0 , 2.7D0 , 2.8D0 , 2.9D0 ,
     &     3.D0 , 3.1D0 , 3.2D0 , 1.877D0 , 1.87701D0 , 1.879D0 ,
     &     1.887D0 , 1.9D0 , 1.917D0 , 1.938D0 , 1.962D0 , 2.D0 ,
     &     2.102D0 , 2.2D0 , 2.3D0 , 2.4D0 , 2.5D0 , 2.6D0 , 2.7D0 ,
     &     2.8D0 , 2.9D0 , 3.D0 , 3.1D0 , 3.2D0 , 1.877D0 , 1.87701D0 ,
     &     1.879D0 , 1.887D0 , 1.9D0 , 1.917D0 , 1.938D0 , 1.962D0 ,
     &     2.D0 , 2.102D0 , 2.2D0 , 2.3D0 , 2.4D0 , 2.5D0 , 2.6D0 ,
     &     2.7D0 , 2.8D0 , 2.9D0 , 3.D0 , 3.1D0 , 3.2D0/
      DATA NRKpi/13 , 1 , 15 , 21 , 81 , 0 , 13 , 54 , 23 , 53 , 13 ,
     &     63 , 13 , 58 , 23 , 57 , 13 , 65 , 1 , 32 , 53 , 31 , 54 ,
     &     32 , 53 , 33 , 53 , 35 , 63 , 32 , 13 , 8 , 23 , 1 , 17 ,
     &     15 , 21 , 24 , 22 , 15 , 82 , 0 , 61 , 0 , 13 , 55 , 23 ,
     &     54 , 14 , 53 , 13 , 64 , 23 , 63 , 13 , 59 , 23 , 58 , 14 ,
     &     57 , 13 , 66 , 23 , 65 , 1 , 31 , 8 , 32 , 1 , 33 , 1 , 35 ,
     &     54 , 31 , 55 , 32 , 54 , 33 , 53 , 34 , 54 , 35 , 14 , 1 ,
     &     23 , 8 , 17 , 24 , 20 , 15 , 22 , 24 , 83 , 0 , 62 , 0 , 14 ,
     &     54 , 23 , 55 , 13 , 56 , 14 , 63 , 23 , 64 , 14 , 58 , 23 ,
     &     59 , 13 , 60 , 14 , 65 , 23 , 66 , 8 , 31 , 1 , 34 , 8 , 33 ,
     &     8 , 35 , 55 , 31 , 54 , 34 , 55 , 33 , 56 , 32 , 55 , 35 ,
     &     14 , 8 , 24 , 20 , 84 , 0 , 14 , 55 , 23 , 56 , 14 , 64 ,
     &     14 , 59 , 23 , 60 , 14 , 66 , 8 , 34 , 56 , 31 , 55 , 34 ,
     &     56 , 33 , 56 , 35 , 64 , 34/
      DATA NRKkc/15 , 1 , 89 , 0 , 24 , 53 , 15 , 54 , 1 , 36 , 1 , 40 ,
     &     1 , 44 , 36 , 63 , 15 , 63 , 45 , 53 , 44 , 54 , 15 , 8 ,
     &     24 , 1 , 91 , 0 , 24 , 54 , 15 , 55 , 8 , 36 , 1 , 37 , 8 ,
     &     40 , 1 , 41 , 8 , 44 , 1 , 45 , 36 , 64 , 37 , 63 , 15 , 64 ,
     &     24 , 63 , 45 , 54 , 44 , 55 , 16 , 1 , 25 , 8 , 17 , 23 ,
     &     21 , 14 , 20 , 13 , 22 , 23 , 90 , 0 , 38 , 1 , 39 , 8 , 16 ,
     &     54 , 25 , 55 , 1 , 42 , 8 , 43 , 16 , 63 , 25 , 64 , 39 ,
     &     64 , 38 , 63 , 46 , 54 , 47 , 55 , 8 , 47 , 1 , 46 , 52 , 0 ,
     &     51 , 0 , 16 , 8 , 17 , 14 , 20 , 23 , 22 , 14 , 92 , 0 , 8 ,
     &     38 , 16 , 55 , 25 , 56 , 8 , 42 , 16 , 64 , 38 , 64 , 46 ,
     &     55 , 47 , 56 , 8 , 46 , 94 , 0/
C                                                                      *
C   k0 p   k0 n   ak0 p   ak0 n                                        *
C                                                                      *
C  KN reaction channels corrected as pointed out by A.Ferrari 18/12/12
C    & 37, 64, 24, 64, 44, 56, 45, 55, 25, 1, 17, 13,   22, 13, 21, 23,
      DATA NRKk0/24 , 8 , 106 , 0 , 15 , 56 , 24 , 55 , 37 , 8 , 41 ,
     &     8 , 45 , 8 , 37 , 64 , 24 , 64 , 44 , 56 , 45 , 55 , 25 , 1 ,
     &     17 , 13 , 21 , 23 , 22 , 13 , 107 , 0 , 39 , 1 , 25 , 54 ,
     &     16 , 53 , 43 , 1 , 25 , 63 , 39 , 63 , 47 , 54 , 46 , 53 ,
     &     47 , 1 , 103 , 0 , 93 , 0/
C   pp  pn   np   nn                                                   *
C  nn reaction channels corrected as pointed out by A.Ferrari 18/12/12
C    & 8, 55, 1, 56, 8, 64, 8, 59, 1, 60, 2*55, 54, 56, 64, 55, 63, 56 /
      DATA NRKp/1 , 1 , 85 , 0 , 8 , 53 , 1 , 54 , 1 , 63 , 8 , 57 , 1 ,
     &     58 , 2*54 , 53 , 55 , 63 , 54 , 64 , 53 , 1 , 8 , 86 , 0 ,
     &     8 , 54 , 1 , 55 , 8 , 63 , 1 , 64 , 8 , 58 , 1 , 59 , 64 ,
     &     54 , 63 , 55 , 54 , 55 , 53 , 56 , 77 , 0 , 2*8 , 95 , 0 ,
     &     1 , 56 , 8 , 55 , 8 , 64 , 1 , 60 , 8 , 59 , 2*55 , 54 , 56 ,
     &     64 , 55 , 63 , 56/

C     app   apn   anp   ann                                            *
      DATA NRKn/1 , 2 , 17 , 18 , 15 , 16 , 8 , 9 , 13 , 14 , 99 , 0 ,
     &     87 , 0 , 1 , 68 , 8 , 69 , 2 , 54 , 9 , 55 , 102 , 0 , 2 ,
     &     63 , 9 , 64 , 1 , 75 , 8 , 76 , 53 , 67 , 54 , 68 , 55 , 69 ,
     &     56 , 70 , 63 , 68 , 64 , 69 , 75 , 54 , 76 , 55 , 2 , 8 ,
     &     18 , 20 , 16 , 24 , 14 , 23 , 101 , 0 , 88 , 0 , 2 , 55 , 9 ,
     &     56 , 1 , 67 , 8 , 68 , 2 , 64 , 8 , 75 , 2 , 59 , 8 , 72 ,
     &     68 , 55 , 67 , 54 , 69 , 56 , 1 , 9 , 18 , 21 , 15 , 25 ,
     &     13 , 23 , 100 , 0 , 96 , 0 , 2 , 53 , 9 , 54 , 1 , 69 , 8 ,
     &     70 , 1 , 76 , 9 , 63 , 1 , 73 , 9 , 58 , 55 , 70 , 53 , 68 ,
     &     54 , 69/
      DATA SPIkp1/0.D0 , 300.D0 , 40.D0 , 20.D0 , 13.D0 , 8.5D0 , 8.D0 ,
     &     9.5D0 , 12.D0 , 14.D0 , 15.5D0 , 20.D0 , 17.D0 , 13.D0 ,
     &     10.D0 , 9.D0 , 8.5D0 , 8.D0 , 7.8D0 , 7.3D0 , 6.7D0 ,
     &     9*0.D0 , .23D0 , .35D0 , .7D0 , .52D0 , .4D0 , .3D0 , .2D0 ,
     &     .15D0 , .13D0 , .11D0 , .09D0 , .07D0 , 0.D0 , .033D0 ,
     &     .8D0 , 1.35D0 , 1.35D0 , .5D0 , 15*0.D0 , 3*0.D0 , .00D0 ,
     &     0.80D0 , 2.2D0 , 3.6D0 , 4.6D0 , 4.7D0 , 3.5D0 , 2.4D0 ,
     &     1.8D0 , 1.4D0 , .75D0 , .47D0 , .25D0 , .13D0 , .08D0 ,
     &     6*0.D0 , 0.D0 , 1.2D0 , 3.3D0 , 5.4D0 , 6.9D0 , 7.3D0 ,
     &     5.3D0 , 3.6D0 , 2.7D0 , 2.2D0 , 1.1D0 , .73D0 , .4D0 ,
     &     .22D0 , .12D0 , 9*0.D0 , .0D0 , 0.D0 , 2.0D0 , 4.4D0 ,
     &     6.8D0 , 9.9D0 , 7.9D0 , 6.0D0 , 3.8D0 , 2.5D0 , 2.D0 ,
     &     1.4D0 , 1.D0 , .6D0 , .35D0 , 10*0.D0 , .25D0 , .55D0 ,
     &     .75D0 , 1.25D0 , 1.9D0 , 2.D0 , 1.8D0 , 1.5D0 , 1.25D0 ,
     &     1.D0 , .8D0 , 6*0.D0 , 4*0.D0 , .4D0 , .85D0 , 1.1D0 ,
     &     1.85D0 , 2.8D0 , 3.D0 , 2.7D0 , 2.2D0 , 1.85D0 , 1.5D0 ,
     &     1.2D0 , 6*0.D0 , 6*0.D0 , .5D0 , 1.2D0 , 1.7D0 , 3.4D0 ,
     &     5.2D0 , 6.4D0 , 6.1D0 , 5.6D0 , 5.2D0 , 6*0.D0 , 2*0.D0 ,
     &     .0D0 , 1.D0 , 3.3D0 , 5.2D0 , 4.45D0 , 3.6D0 , 2.75D0 ,
     &     1.9D0 , 1.65D0 , 1.3D0 , .95D0 , .6D0 , .45D0 , 6*0.D0 ,
     &     3*0.D0 , .0D0 , .45D0 , 1.4D0 , 1.5D0 , 1.1D0 , .85D0 ,
     &     .5D0 , .3D0 , .2D0 , .15D0 , 8*0.D0 , 5*0.D0 , .0D0 , .0D0 ,
     &     .6D0 , .8D0 , .95D0 , .8D0 , .7D0 , .6D0 , .5D0 , .4D0 ,
     &     6*0.D0 , 5*0.D0 , .0D0 , .00D0 , .85D0 , 1.2D0 , 1.4D0 ,
     &     1.2D0 , 1.05D0 , .9D0 , .7D0 , .55D0 , 6*0.D0 , 5*0.D0 ,
     &     .0D0 , .00D0 , 1.D0 , 1.5D0 , 3.5D0 , 4.15D0 , 3.7D0 ,
     &     2.7D0 , 2.3D0 , 1.75D0 , 6*0.D0 , 10*0.D0 , .5D0 , 2.0D0 ,
     &     3.3D0 , 5.4D0 , 7.D0/
      DATA SPIkpu/0.D0 , 25.D0 , 13.D0 , 11.D0 , 10.5D0 , 14.D0 ,
     &     20.D0 , 20.D0 , 16.D0 , 14.D0 , 19.D0 , 28.D0 , 17.5D0 ,
     &     13.5D0 , 12.D0 , 10.5D0 , 10.D0 , 10.D0 , 9.5D0 , 9.D0 ,
     &     8.D0 , 7.5D0 , 7.D0 , 6.5D0 , 6.D0 , 0.D0 , 48.D0 , 19.D0 ,
     &     15.D0 , 11.5D0 , 10.D0 , 8.D0 , 6.5D0 , 5.5D0 , 4.8D0 ,
     &     4.2D0 , 7.5D0 , 3.4D0 , 2.5D0 , 2.5D0 , 2.1D0 , 1.4D0 ,
     &     1.D0 , .8D0 , .6D0 , .46D0 , .3D0 , .2D0 , .15D0 , .13D0 ,
     &     11*0.D0 , .95D0 , .65D0 , .48D0 , .35D0 , .2D0 , .18D0 ,
     &     .17D0 , .16D0 , .15D0 , .1D0 , .09D0 , .065D0 , .05D0 ,
     &     .04D0 , 12*0.D0 , .2D0 , .25D0 , .25D0 , .2D0 , .1D0 ,
     &     .08D0 , .06D0 , .045D0 , .03D0 , .02D0 , .01D0 , .005D0 ,
     &     .003D0 , 12*0.D0 , .3D0 , .24D0 , .18D0 , .15D0 , .13D0 ,
     &     .12D0 , .11D0 , .1D0 , .09D0 , .08D0 , .05D0 , .04D0 ,
     &     .03D0 , 0.D0 , 0.16D0 , .7D0 , 1.3D0 , 3.1D0 , 4.5D0 , 2.D0 ,
     &     18*0.D0 , 3*.0D0 , 0.D0 , 0.D0 , 4.0D0 , 11.D0 , 11.4D0 ,
     &     10.3D0 , 7.5D0 , 6.8D0 , 4.75D0 , 2.5D0 , 1.5D0 , .9D0 ,
     &     .55D0 , .35D0 , 13*0.D0 , .1D0 , .34D0 , .5D0 , .8D0 ,
     &     1.1D0 , 2.25D0 , 3.3D0 , 2.3D0 , 1.6D0 , .95D0 , .45D0 ,
     &     .28D0 , .15D0 , 10*0.D0 , 2*0.D0 , .17D0 , .64D0 , 1.D0 ,
     &     1.5D0 , 2.1D0 , 4.25D0 , 6.2D0 , 4.4D0 , 3.D0 , 1.8D0 ,
     &     .9D0 , .53D0 , .28D0 , 10*0.D0 , 2*0.D0 , .25D0 , .82D0 ,
     &     1.3D0 , 1.9D0 , 2.8D0 , 5.5D0 , 8.D0 , 5.7D0 , 3.9D0 ,
     &     2.35D0 , 1.15D0 , .69D0 , .37D0 , 10*0.D0 , 7*0.D0 , .0D0 ,
     &     .34D0 , 1.5D0 , 3.47D0 , 5.87D0 , 6.23D0 , 4.27D0 , 2.6D0 ,
     &     1.D0 , .6D0 , .3D0 , .15D0 , 6*0.D0/
C
      DATA SPIkpv/7*0.D0 , .00D0 , .16D0 , .75D0 , 1.73D0 , 2.93D0 ,
     &     3.12D0 , 2.13D0 , 1.3D0 , .5D0 , .3D0 , .15D0 , .08D0 ,
     &     6*0.D0 , 10*0.D0 , .2D0 , .6D0 , .92D0 , 2.4D0 , 4.9D0 ,
     &     6.25D0 , 5.25D0 , 3.5D0 , 2.15D0 , 1.4D0 , 1.D0 , .7D0 ,
     &     13*0.D0 , .13D0 , .4D0 , .62D0 , 1.6D0 , 3.27D0 , 4.17D0 ,
     &     3.5D0 , 2.33D0 , 1.43D0 , .93D0 , .66D0 , .47D0 , 13*0.D0 ,
     &     .07D0 , .2D0 , .31D0 , .8D0 , 1.63D0 , 2.08D0 , 1.75D0 ,
     &     1.17D0 , .72D0 , .47D0 , .34D0 , .23D0 , 17*0.D0 , .33D0 ,
     &     1.D0 , 1.8D0 , 2.67D0 , 5.33D0 , 6.D0 , 5.53D0 , 5.D0 ,
     &     17*0.D0 , .17D0 , .5D0 , .9D0 , 1.83D0 , 2.67D0 , 3.0D0 ,
     &     2.77D0 , 2.5D0 , 3*0.D0 , 3*0.D0 , 1.D0 , 3.3D0 , 2.8D0 ,
     &     2.5D0 , 2.3D0 , 1.8D0 , 1.5D0 , 1.1D0 , .8D0 , .7D0 , .55D0 ,
     &     .3D0 , 10*0.D0 , 9*0.D0 , .1D0 , .4D0 , 1.D0 , 1.4D0 ,
     &     2.2D0 , 2.5D0 , 2.2D0 , 1.65D0 , 1.35D0 , 1.1D0 , .8D0 ,
     &     .6D0 , .4D0 , 12*0.D0 , .15D0 , .6D0 , 1.5D0 , 2.1D0 ,
     &     3.3D0 , 3.8D0 , 3.3D0 , 2.45D0 , 2.05D0 , 1.65D0 , 1.2D0 ,
     &     .9D0 , .6D0 , 3*0.D0 , 9*0.D0 , .10D0 , .2D0 , .5D0 , .7D0 ,
     &     1.3D0 , 1.55D0 , 1.9D0 , 1.8D0 , 1.55D0 , 1.35D0 , 1.15D0 ,
     &     .95D0 , .7D0 , 13*0.D0 , .2D0 , .5D0 , .7D0 , 1.3D0 ,
     &     1.55D0 , 1.9D0 , 1.8D0 , 1.55D0 , 1.35D0 , 1.15D0 , .95D0 ,
     &     .7D0 , 17*0.D0 , .2D0 , .5D0 , .85D0 , 2.D0 , 2.15D0 ,
     &     2.05D0 , 1.75D0 , 1.D0 , 17*0.D0 , .13D0 , .33D0 , .57D0 ,
     &     1.33D0 , 1.43D0 , 1.36D0 , 1.17D0 , .67D0 , 17*0.D0 , .07D0 ,
     &     .17D0 , .28D0 , .67D0 , .72D0 , .69D0 , .58D0 , .33D0 ,
     &     17*0.D0 , .4D0 , .7D0 , 1.D0 , 1.6D0 , 1.8D0 , 2.3D0 ,
     &     1.9D0 , 1.7D0/
      DATA SPIkpw/0.D0 , 25.D0 , 13.D0 , 11.D0 , 10.5D0 , 14.D0 ,
     &     2*20.D0 , 16.D0 , 14.D0 , 19.D0 , 28.D0 , 17.5D0 , 13.5D0 ,
     &     12.D0 , 10.5D0 , 2*10.D0 , 9.5D0 , 9.D0 , 8.D0 , 7.5D0 ,
     &     7.D0 , 6.5D0 , 6.D0 , 0.D0 , 48.D0 , 19.D0 , 15.D0 , 11.5D0 ,
     &     10.D0 , 8.D0 , 6.5D0 , 5.5D0 , 4.8D0 , 4.2D0 , 7.5D0 ,
     &     3.4D0 , 2*2.5D0 , 2.1D0 , 1.4D0 , 1.D0 , .8D0 , .6D0 ,
     &     .46D0 , .3D0 , .2D0 , .15D0 , .13D0 , 11*0.D0 , .95D0 ,
     &     .65D0 , .48D0 , .35D0 , .2D0 , .18D0 , .17D0 , .16D0 ,
     &     .15D0 , .1D0 , .09D0 , .065D0 , .05D0 , .04D0 , 12*0.D0 ,
     &     .2D0 , 2*.25D0 , .2D0 , .1D0 , .08D0 , .06D0 , .045D0 ,
     &     .03D0 , .02D0 , .01D0 , .005D0 , .003D0 , 12*0.D0 , .3D0 ,
     &     .24D0 , .18D0 , .15D0 , .13D0 , .12D0 , .11D0 , .1D0 ,
     &     .09D0 , .08D0 , .05D0 , .04D0 , .03D0 , 0.D0 , 0.16D0 ,
     &     .7D0 , 1.3D0 , 3.1D0 , 4.5D0 , 2.D0 , 23*0.D0 , 4.0D0 ,
     &     11.D0 , 11.4D0 , 10.3D0 , 7.5D0 , 6.8D0 , 4.75D0 , 2.5D0 ,
     &     1.5D0 , .9D0 , .55D0 , .35D0 , 13*0.D0 , .1D0 , .34D0 ,
     &     .5D0 , .8D0 , 1.1D0 , 2.25D0 , 3.3D0 , 2.3D0 , 1.6D0 ,
     &     .95D0 , .45D0 , .28D0 , .15D0 , 12*0.D0 , .17D0 , .64D0 ,
     &     1.D0 , 1.5D0 , 2.1D0 , 4.25D0 , 6.2D0 , 4.4D0 , 3.D0 ,
     &     1.8D0 , .9D0 , .53D0 , .28D0 , 12*0.D0 , .25D0 , .82D0 ,
     &     1.3D0 , 1.9D0 , 2.8D0 , 5.5D0 , 8.D0 , 5.7D0 , 3.9D0 ,
     &     2.35D0 , 1.15D0 , .69D0 , .37D0 , 18*0.D0 , .34D0 , 1.5D0 ,
     &     3.47D0 , 5.87D0 , 6.23D0 , 4.27D0 , 2.6D0 , 1.D0 , .6D0 ,
     &     .3D0 , .15D0 , 6*0.D0/
C
      DATA SPIkpx/8*0.D0 , .16D0 , .75D0 , 1.73D0 , 2.93D0 , 3.12D0 ,
     &     2.13D0 , 1.3D0 , .5D0 , .3D0 , .15D0 , .08D0 , 16*0.D0 ,
     &     .2D0 , .6D0 , .92D0 , 2.4D0 , 4.9D0 , 6.25D0 , 5.25D0 ,
     &     3.5D0 , 2.15D0 , 1.4D0 , 1.D0 , .7D0 , 13*0.D0 , .13D0 ,
     &     .4D0 , .62D0 , 1.6D0 , 3.27D0 , 4.17D0 , 3.5D0 , 2.33D0 ,
     &     1.43D0 , .93D0 , .66D0 , .47D0 , 13*0.D0 , .07D0 , .2D0 ,
     &     .31D0 , .8D0 , 1.63D0 , 2.08D0 , 1.75D0 , 1.17D0 , .72D0 ,
     &     .47D0 , .34D0 , .23D0 , 17*0.D0 , .33D0 , 1.D0 , 1.8D0 ,
     &     2.67D0 , 5.33D0 , 6.D0 , 5.53D0 , 5.D0 , 17*0.D0 , .17D0 ,
     &     .5D0 , .9D0 , 1.83D0 , 2.67D0 , 3.0D0 , 2.77D0 , 2.5D0 ,
     &     6*0.D0 , 1.D0 , 3.3D0 , 2.8D0 , 2.5D0 , 2.3D0 , 1.8D0 ,
     &     1.5D0 , 1.1D0 , .8D0 , .7D0 , .55D0 , .3D0 , 19*0.D0 , .1D0 ,
     &     .4D0 , 1.D0 , 1.4D0 , 2.2D0 , 2.5D0 , 2.2D0 , 1.65D0 ,
     &     1.35D0 , 1.1D0 , .8D0 , .6D0 , .4D0 , 12*0.D0 , .15D0 ,
     &     .6D0 , 1.5D0 , 2.1D0 , 3.3D0 , 3.8D0 , 3.3D0 , 2.45D0 ,
     &     2.05D0 , 1.65D0 , 1.2D0 , .9D0 , .6D0 , 12*0.D0 , .10D0 ,
     &     .2D0 , .5D0 , .7D0 , 1.3D0 , 1.55D0 , 1.9D0 , 1.8D0 ,
     &     1.55D0 , 1.35D0 , 1.15D0 , .95D0 , .7D0 , 13*0.D0 , .2D0 ,
     &     .5D0 , .7D0 , 1.3D0 , 1.55D0 , 1.9D0 , 1.8D0 , 1.55D0 ,
     &     1.35D0 , 1.15D0 , .95D0 , .7D0 , 17*0.D0 , .2D0 , .5D0 ,
     &     .85D0 , 2.D0 , 2.15D0 , 2.05D0 , 1.75D0 , 1.D0 , 17*0.D0 ,
     &     .13D0 , .33D0 , .57D0 , 1.33D0 , 1.43D0 , 1.36D0 , 1.17D0 ,
     &     .67D0 , 17*0.D0 , .07D0 , .17D0 , .28D0 , .67D0 , .72D0 ,
     &     .69D0 , .58D0 , .33D0 , 17*0.D0 , .4D0 , .7D0 , 1.D0 ,
     &     1.6D0 , 1.8D0 , 2.3D0 , 1.9D0 , 1.7D0/
      DATA SPIkp4/0.D0 , 300.D0 , 40.D0 , 20.D0 , 13.D0 , 8.5D0 , 8.D0 ,
     &     9.5D0 , 12.D0 , 14.D0 , 15.5D0 , 20.D0 , 17.D0 , 13.D0 ,
     &     10.D0 , 9.D0 , 8.5D0 , 8.D0 , 7.8D0 , 7.3D0 , 6.7D0 ,
     &     9*0.D0 , .23D0 , .35D0 , .7D0 , .52D0 , .4D0 , .3D0 , .2D0 ,
     &     .15D0 , .13D0 , .11D0 , .09D0 , .07D0 , 0.D0 , .033D0 ,
     &     .8D0 , 2*1.35D0 , .5D0 , 19*0.D0 , 0.8D0 , 2.2D0 , 3.6D0 ,
     &     4.6D0 , 4.7D0 , 3.5D0 , 2.4D0 , 1.8D0 , 1.4D0 , .75D0 ,
     &     .47D0 , .25D0 , .13D0 , .08D0 , 7*0.D0 , 1.2D0 , 3.3D0 ,
     &     5.4D0 , 6.9D0 , 7.3D0 , 5.3D0 , 3.6D0 , 2.7D0 , 2.2D0 ,
     &     1.1D0 , .73D0 , .4D0 , .22D0 , .12D0 , 11*0.D0 , 2.0D0 ,
     &     4.4D0 , 6.8D0 , 9.9D0 , 7.9D0 , 6.0D0 , 3.8D0 , 2.5D0 ,
     &     2.D0 , 1.4D0 , 1.D0 , .6D0 , .35D0 , 10*0.D0 , .25D0 ,
     &     .55D0 , .75D0 , 1.25D0 , 1.9D0 , 2.D0 , 1.8D0 , 1.5D0 ,
     &     1.25D0 , 1.D0 , .8D0 , 10*0.D0 , .4D0 , .85D0 , 1.1D0 ,
     &     1.85D0 , 2.8D0 , 3.D0 , 2.7D0 , 2.2D0 , 1.85D0 , 1.5D0 ,
     &     1.2D0 , 12*0.D0 , .5D0 , 1.2D0 , 1.7D0 , 3.4D0 , 5.2D0 ,
     &     6.4D0 , 6.1D0 , 5.6D0 , 5.2D0 , 9*0.D0 , 1.D0 , 3.3D0 ,
     &     5.2D0 , 4.45D0 , 3.6D0 , 2.75D0 , 1.9D0 , 1.65D0 , 1.3D0 ,
     &     .95D0 , .6D0 , .45D0 , 10*0.D0 , .45D0 , 1.4D0 , 1.5D0 ,
     &     1.1D0 , .85D0 , .5D0 , .3D0 , .2D0 , .15D0 , 15*0.D0 , .6D0 ,
     &     .8D0 , .95D0 , .8D0 , .7D0 , .6D0 , .5D0 , .4D0 , 13*0.D0 ,
     &     .85D0 , 1.2D0 , 1.4D0 , 1.2D0 , 1.05D0 , .9D0 , .7D0 ,
     &     .55D0 , 13*0.D0 , 1.D0 , 1.5D0 , 3.5D0 , 4.15D0 , 3.7D0 ,
     &     2.7D0 , 2.3D0 , 1.75D0 , 16*0.D0 , .5D0 , 2.0D0 , 3.3D0 ,
     &     5.4D0 , 7.D0/
      DATA SPIkp5/0.D0 , 20.D0 , 14.D0 , 12.D0 , 11.5D0 , 10.D0 , 8.D0 ,
     &     7.D0 , 6.D0 , 5.5D0 , 5.3D0 , 5.D0 , 4.5D0 , 4.4D0 , 3.8D0 ,
     &     3.D0 , 2.8D0 , 0.D0 , .5D0 , 1.15D0 , 2.D0 , 1.3D0 , .8D0 ,
     &     .45D0 , 13*0.D0 , 0.9D0 , 2.5D0 , 3.D0 , 2.5D0 , 2.3D0 ,
     &     2.D0 , 1.7D0 , 1.5D0 , 1.2D0 , .9D0 , .6D0 , .45D0 , .21D0 ,
     &     .2D0 , 3*0.D0 , .9D0 , 2.5D0 , 3.D0 , 2.5D0 , 2.3D0 , 2.D0 ,
     &     1.7D0 , 1.5D0 , 1.2D0 , .9D0 , .6D0 , .45D0 , .21D0 , .2D0 ,
     &     4*0.D0 , 1.D0 , 2.1D0 , 2.6D0 , 2.3D0 , 2.1D0 , 1.8D0 ,
     &     1.7D0 , 1.4D0 , 1.2D0 , 1.05D0 , .9D0 , .66D0 , .5D0 ,
     &     7*0.D0 , .3D0 , 2*1.D0 , .9D0 , .7D0 , .4D0 , .3D0 , .2D0 ,
     &     11*0.D0 , .1D0 , 1.D0 , 2.2D0 , 3.5D0 , 4.2D0 , 4.55D0 ,
     &     4.85D0 , 4.9D0 , 10*0.D0 , .2D0 , .7D0 , 1.6D0 , 2.5D0 ,
     &     2.2D0 , 1.71D0 , 1.6D0 , 6*0.D0 , 1.4D0 , 3.8D0 , 5.D0 ,
     &     4.7D0 , 4.4D0 , 4.D0 , 3.5D0 , 2.85D0 , 2.35D0 , 2.01D0 ,
     &     1.8D0 , 12*0.D0 , .1D0 , .8D0 , 2.05D0 , 3.31D0 , 3.5D0 ,
     &     12*0.D0 , .034D0 , .2D0 , .75D0 , 1.04D0 , 1.24D0/
      DATA SPIkp6/0.D0 , 6.D0 , 11.D0 , 13.D0 , 6.D0 , 5.D0 , 3.D0 ,
     &     2.2D0 , 1.5D0 , 1.2D0 , 1.D0 , .7D0 , .6D0 , .5D0 , .45D0 ,
     &     .35D0 , .3D0 , 0.D0 , 6.D0 , 11.D0 , 13.D0 , 6.D0 , 5.D0 ,
     &     3.D0 , 2.2D0 , 1.5D0 , 1.2D0 , 1.D0 , .7D0 , .6D0 , .5D0 ,
     &     .45D0 , .35D0 , .3D0 , 0.D0 , .5D0 , 1.3D0 , 2.8D0 , 2.3D0 ,
     &     1.6D0 , .9D0 , 13*0.D0 , 0.9D0 , 2.5D0 , 3.D0 , 2.5D0 ,
     &     2.3D0 , 2.D0 , 1.7D0 , 1.5D0 , 1.2D0 , .9D0 , .6D0 , .45D0 ,
     &     .21D0 , .2D0 , 3*0.D0 , 0.9D0 , 2.5D0 , 3.D0 , 2.5D0 ,
     &     2.3D0 , 2.D0 , 1.7D0 , 1.5D0 , 1.2D0 , .9D0 , .6D0 , .45D0 ,
     &     .21D0 , .2D0 , 4*0.D0 , 1.D0 , 2.1D0 , 2.6D0 , 2.3D0 , 2.D0 ,
     &     1.8D0 , 1.7D0 , 1.4D0 , 1.2D0 , 1.15D0 , .9D0 , .66D0 ,
     &     .5D0 , 4*0.D0 , 1.D0 , 2.1D0 , 2.6D0 , 2.3D0 , 2.1D0 ,
     &     1.8D0 , 1.7D0 , 1.4D0 , 1.2D0 , 1.15D0 , .9D0 , .66D0 ,
     &     .5D0 , 7*0.D0 , .3D0 , 2*1.D0 , .9D0 , .7D0 , .4D0 , .35D0 ,
     &     .2D0 , 9*0.D0 , .3D0 , 2*1.D0 , .9D0 , .7D0 , .4D0 , .35D0 ,
     &     .2D0 , 11*0.D0 , .1D0 , 1.D0 , 2.4D0 , 3.5D0 , 4.25D0 ,
     &     4.55D0 , 4.85D0 , 4.9D0 , 9*0.D0 , .1D0 , 1.D0 , 2.4D0 ,
     &     3.5D0 , 4.25D0 , 4.55D0 , 4.85D0 , 4.9D0 , 10*0.D0 , .2D0 ,
     &     .7D0 , 1.6D0 , 2.5D0 , 2.2D0 , 1.71D0 , 1.6D0 , 10*0.D0 ,
     &     .2D0 , .7D0 , 1.6D0 , 2.5D0 , 2.2D0 , 1.71D0 , 1.6D0 ,
     &     6*0.D0 , 1.4D0 , 3.8D0 , 5.D0 , 4.7D0 , 4.4D0 , 4.D0 ,
     &     3.5D0 , 2.85D0 , 2.35D0 , 2.01D0 , 1.8D0 , 6*0.D0 , 1.4D0 ,
     &     3.8D0 , 5.D0 , 4.7D0 , 4.4D0 , 4.D0 , 3.5D0 , 2.85D0 ,
     &     2.35D0 , 2.01D0 , 1.8D0 , 12*0.D0 , .1D0 , .8D0 , 2.05D0 ,
     &     3.31D0 , 3.5D0 , 12*0.D0 , .034D0 , .2D0 , .75D0 , 1.04D0 ,
     &     1.24D0/
      DATA SKMpel/0.D0 , 35.D0 , 22.D0 , 25.D0 , 17.D0 , 9.D0 , 9.5D0 ,
     &     8.D0 , 7.D0 , 6.5D0 , 6.1D0 , 5.D0 , 4.8D0 , 4.6D0 , 4.45D0 ,
     &     4.3D0 , 4.2D0 , 0.D0 , 8.D0 , 3.5D0 , 8.D0 , 3.D0 , 1.9D0 ,
     &     1.7D0 , 1.D0 , .9D0 , .8D0 , .75D0 , .5D0 , .42D0 , .38D0 ,
     &     .34D0 , .25D0 , .2D0 , 0.D0 , 3.D0 , 3.2D0 , 3.5D0 , 1.5D0 ,
     &     1.4D0 , 1.1D0 , .6D0 , .5D0 , .35D0 , .28D0 , .25D0 , .18D0 ,
     &     .12D0 , .1D0 , .08D0 , .04D0 , 0.D0 , 8.5D0 , 2.4D0 , 1.7D0 ,
     &     1.3D0 , 1.3D0 , 1.1D0 , .5D0 , .4D0 , .4D0 , .35D0 , .3D0 ,
     &     .28D0 , .2D0 , .16D0 , .13D0 , .11D0 , 0.D0 , 7.D0 , 4.8D0 ,
     &     1.4D0 , 1.9D0 , .9D0 , .4D0 , .2D0 , .13D0 , .1D0 , .08D0 ,
     &     .06D0 , .04D0 , .02D0 , .015D0 , .01D0 , .01D0 , 0.D0 ,
     &     5.5D0 , 1.D0 , .8D0 , .75D0 , .32D0 , .2D0 , .1D0 , .09D0 ,
     &     .08D0 , .065D0 , .05D0 , .04D0 , .022D0 , .017D0 , 2*.01D0/
      DATA SPIkp7/0.D0 , .56D0 , 1.46D0 , 3.16D0 , 2.01D0 , 1.28D0 ,
     &     .74D0 , 14*0.D0 , 1.13D0 , 2.61D0 , 2.91D0 , 2.58D0 ,
     &     2.35D0 , 2.02D0 , 1.91D0 , 1.57D0 , 1.35D0 , 1.29D0 ,
     &     1.01D0 , .74D0 , .65D0 , 4*0.D0 , 1.13D0 , 2.61D0 , 2.91D0 ,
     &     2.58D0 , 2.35D0 , 2.02D0 , 1.91D0 , 1.57D0 , 1.35D0 ,
     &     1.29D0 , 1.01D0 , .74D0 , .65D0 , 3*0.D0 , 1.0D0 , 3.03D0 ,
     &     3.36D0 , 2.8D0 , 2.58D0 , 2.24D0 , 1.91D0 , 1.68D0 , 1.35D0 ,
     &     1.01D0 , .67D0 , .5D0 , .24D0 , .23D0 , 3*0.D0 , 1.0D0 ,
     &     3.03D0 , 3.36D0 , 2.8D0 , 2.58D0 , 2.24D0 , 1.91D0 , 1.68D0 ,
     &     1.35D0 , 1.01D0 , .67D0 , .5D0 , .24D0 , .23D0 , 7*0.D0 ,
     &     .34D0 , 1.12D0 , 1.12D0 , 1.01D0 , .78D0 , .45D0 , .39D0 ,
     &     .22D0 , .07D0 , 0.D0 , 7*0.D0 , .34D0 , 1.12D0 , 1.12D0 ,
     &     1.01D0 , .78D0 , .45D0 , .39D0 , .22D0 , .07D0 , 0.D0 ,
     &     6*0.D0 , 1.71D0 , 4.26D0 , 5.6D0 , 5.57D0 , 4.93D0 , 4.48D0 ,
     &     3.92D0 , 3.19D0 , 2.63D0 , 2.25D0 , 2.D0 , 6*0.D0 , 1.71D0 ,
     &     4.26D0 , 5.6D0 , 5.57D0 , 4.93D0 , 4.48D0 , 3.92D0 , 3.19D0 ,
     &     2.63D0 , 2.25D0 , 2.D0 , 10*0.D0 , .22D0 , .8D0 , .75D0 ,
     &     1.D0 , 1.3D0 , 1.5D0 , 1.3D0 , 10*0.D0 , .22D0 , .8D0 ,
     &     .75D0 , 1.D0 , 1.3D0 , 1.5D0 , 1.3D0 , 13*0.D0 , .1D0 ,
     &     .3D0 , .7D0 , 1.D0 , 13*0.D0 , .1D0 , .3D0 , .7D0 , 1.D0 ,
     &     9*0.D0 , .11D0 , 1.72D0 , 2.69D0 , 3.92D0 , 4.76D0 , 5.10D0 ,
     &     5.44D0 , 5.3D0 , 9*0.D0 , .11D0 , 1.72D0 , 2.69D0 , 3.92D0 ,
     &     4.76D0 , 5.1D0 , 5.44D0 , 5.3D0 , 5*0.D0 , 9.2D0 , 4.7D0 ,
     &     1.9D0 , 10*0.D0 , 2.5D0 , 15.D0 , 21.5D0 , 15.3D0 , 3.D0 ,
     &     1.5D0 , 10*0.D0/
C**** k- n data                                                        *
      DATA SKMnel/0.D0 , 4.D0 , 9.5D0 , 20.D0 , 13.D0 , 9.5D0 , 6.D0 ,
     &     4.4D0 , 3.D0 , 2.4D0 , 2.D0 , 1.4D0 , 1.2D0 , 1.D0 , .9D0 ,
     &     .7D0 , .6D0 , 0.D0 , 4.5D0 , 6.D0 , 5.D0 , 2.5D0 , 2.D0 ,
     &     1.7D0 , 2.1D0 , 1.9D0 , .9D0 , .5D0 , .3D0 , .24D0 , .2D0 ,
     &     .18D0 , .1D0 , .09D0 , 0.D0 , 1.8D0 , 2.D0 , 1.1D0 , .9D0 ,
     &     .5D0 , .5D0 , .4D0 , .4D0 , .2D0 , .1D0 , .06D0 , .05D0 ,
     &     .04D0 , .03D0 , .02D0 , .02D0 , 0.D0 , 1.5D0 , 2.D0 , .9D0 ,
     &     1.1D0 , .4D0 , .6D0 , .7D0 , .65D0 , .3D0 , .17D0 , .1D0 ,
     &     .08D0 , .07D0 , .06D0 , .04D0 , .03D0/
      DATA SPIkp8/0.D0 , .56D0 , 1.29D0 , 2.26D0 , 1.01D0 , .64D0 ,
     &     .37D0 , 14*0.D0 , 1.13D0 , 2.61D0 , 2.91D0 , 2.58D0 ,
     &     2.35D0 , 2.02D0 , 1.91D0 , 1.57D0 , 1.35D0 , 1.29D0 ,
     &     1.01D0 , .74D0 , .65D0 , 3*0.D0 , 1.D0 , 3.03D0 , 3.36D0 ,
     &     2.8D0 , 2.58D0 , 2.24D0 , 1.91D0 , 1.68D0 , 1.35D0 , 1.01D0 ,
     &     .67D0 , .5D0 , .24D0 , .23D0 , 3*0.D0 , 1.D0 , 3.03D0 ,
     &     3.36D0 , 2.8D0 , 2.58D0 , 2.24D0 , 1.91D0 , 1.68D0 , 1.35D0 ,
     &     1.01D0 , .67D0 , .5D0 , .24D0 , .23D0 , 7*0.D0 , .34D0 ,
     &     1.12D0 , 1.12D0 , 1.01D0 , .78D0 , .45D0 , .39D0 , .22D0 ,
     &     .07D0 , 0.D0 , 6*0.D0 , 1.71D0 , 4.26D0 , 5.6D0 , 5.57D0 ,
     &     4.93D0 , 4.48D0 , 3.92D0 , 3.19D0 , 2.63D0 , 2.25D0 , 2.D0 ,
     &     10*0.D0 , .22D0 , .8D0 , .75D0 , 1.D0 , 1.3D0 , 1.5D0 ,
     &     1.3D0 , 13*0.D0 , .1D0 , .3D0 , .7D0 , 1.D0 , 13*0.D0 ,
     &     .1D0 , .3D0 , .7D0 , 1.D0 , 9*0.D0 , .11D0 , 1.72D0 ,
     &     2.69D0 , 3.92D0 , 4.76D0 , 5.10D0 , 5.44D0 , 5.3D0 , 4*0.D0 ,
     &     0.00D0 , 9.2D0 , 4.7D0 , 1.9D0 , 9*0.D0/
C****  p p data                                                        *
      DATA SPIkp9/0.D0 , 24.D0 , 25.D0 , 27.D0 , 23.D0 , 21.D0 , 20.D0 ,
     &     19.D0 , 17.D0 , 15.5D0 , 14.D0 , 13.5D0 , 13.D0 , 0.D0 ,
     &     3.6D0 , 1.7D0 , 10*0.D0 , .0D0 , 0.D0 , 8.7D0 , 17.7D0 ,
     &     18.8D0 , 15.9D0 , 11.7D0 , 8.D0 , 6.D0 , 5.3D0 , 4.5D0 ,
     &     3.9D0 , 3.5D0 , .0D0 , .0D0 , 2.8D0 , 5.8D0 , 6.2D0 , 5.1D0 ,
     &     3.8D0 , 2.7D0 , 2.1D0 , 1.8D0 , 1.5D0 , 1.3D0 , 1.1D0 ,
     &     5*0.D0 , 4.6D0 , 10.2D0 , 15.1D0 , 16.9D0 , 16.5D0 , 11.D0 ,
     &     5.5D0 , 3.5D0 , 10*0.D0 , 4.3D0 , 7.6D0 , 9.D0 , 10*0.D0 ,
     &     1.7D0 , 2.6D0 , 3.D0 , 6*0.D0 , .3D0 , .6D0 , 1.D0 , 1.6D0 ,
     &     1.3D0 , .8D0 , .6D0 , 6*0.D0 , .7D0 , 1.2D0 , 1.8D0 , 2.5D0 ,
     &     1.8D0 , 1.3D0 , 1.2D0 , 10*0.D0 , .6D0 , 1.4D0 , 1.7D0 ,
     &     10*0.D0 , 1.9D0 , 4.1D0 , 5.2D0/
C****  p n data                                                        *
      DATA SPIkp0/0.D0 , 24.D0 , 25.D0 , 27.D0 , 23.D0 , 21.D0 , 20.D0 ,
     &     19.D0 , 17.D0 , 15.5D0 , 14.D0 , 13.5D0 , 13.D0 , 0.D0 ,
     &     1.8D0 , .2D0 , 12*0.D0 , 3.2D0 , 6.05D0 , 9.9D0 , 5.1D0 ,
     &     3.8D0 , 2.7D0 , 1.9D0 , 1.5D0 , 1.4D0 , 1.3D0 , 1.1D0 ,
     &     2*.0D0 , 3.2D0 , 6.05D0 , 9.9D0 , 5.1D0 , 3.8D0 , 2.7D0 ,
     &     1.9D0 , 1.5D0 , 1.4D0 , 1.3D0 , 1.1D0 , 5*0.D0 , 4.6D0 ,
     &     10.2D0 , 15.1D0 , 16.4D0 , 15.2D0 , 11.D0 , 5.4D0 , 3.5D0 ,
     &     5*0.D0 , 4.6D0 , 10.2D0 , 15.1D0 , 16.4D0 , 15.2D0 , 11.D0 ,
     &     5.4D0 , 3.5D0 , 10*0.D0 , .7D0 , 5.1D0 , 8.D0 , 10*0.D0 ,
     &     .7D0 , 5.1D0 , 8.D0 , 10*.0D0 , .3D0 , 2.8D0 , 4.7D0 ,
     &     10*.0D0 , .3D0 , 2.8D0 , 4.7D0 , 7*0.D0 , 1.2D0 , 2.5D0 ,
     &     3.5D0 , 6.D0 , 5.3D0 , 2.9D0 , 7*0.D0 , 1.7D0 , 3.6D0 ,
     &     5.4D0 , 9.D0 , 7.6D0 , 4.2D0 , 5*0.D0 , 7.7D0 , 6.1D0 ,
     &     2.9D0 , 5*0.D0/
C   nn - data                                                          *
C                                                                      *
      DATA SPKpv/0.D0 , 24.D0 , 25.D0 , 27.D0 , 23.D0 , 21.D0 , 20.D0 ,
     &     19.D0 , 17.D0 , 15.5D0 , 14.D0 , 13.5D0 , 13.D0 , 0.D0 ,
     &     3.6D0 , 1.7D0 , 12*0.D0 , 8.7D0 , 17.7D0 , 18.8D0 , 15.9D0 ,
     &     11.7D0 , 8.D0 , 6.D0 , 5.3D0 , 4.5D0 , 3.9D0 , 3.5D0 , .0D0 ,
     &     .0D0 , 2.8D0 , 5.8D0 , 6.2D0 , 5.1D0 , 3.8D0 , 2.7D0 ,
     &     2.1D0 , 1.8D0 , 1.5D0 , 1.3D0 , 1.1D0 , 5*0.D0 , 4.6D0 ,
     &     10.2D0 , 15.1D0 , 16.9D0 , 16.5D0 , 11.D0 , 5.5D0 , 3.5D0 ,
     &     10*0.D0 , 4.3D0 , 7.6D0 , 9.D0 , 10*0.D0 , 1.7D0 , 2.6D0 ,
     &     3.D0 , 6*0.D0 , .3D0 , .6D0 , 1.D0 , 1.6D0 , 1.3D0 , .8D0 ,
     &     .6D0 , 6*0.D0 , .7D0 , 1.2D0 , 1.8D0 , 2.5D0 , 1.8D0 ,
     &     1.3D0 , 1.2D0 , 10*0.D0 , .6D0 , 1.4D0 , 1.7D0 , 10*0.D0 ,
     &     1.9D0 , 4.1D0 , 5.2D0/
C***************   ap - p - data                                       *
      DATA SAPpel/0.D0 , 176.D0 , 160.D0 , 105.D0 , 75.D0 , 68.D0 ,
     &     65.D0 , 50.D0 , 50.D0 , 43.D0 , 42.D0 , 40.5D0 , 35.D0 ,
     &     30.D0 , 28.D0 , 25.D0 , 22.D0 , 21.D0 , 20.D0 , 18.D0 ,
     &     17.D0 , 11*0.D0 , .05D0 , .15D0 , .18D0 , .2D0 , .2D0 ,
     &     .3D0 , .4D0 , .6D0 , .7D0 , .85D0 , 0.D0 , 1.D0 , .9D0 ,
     &     .46D0 , .3D0 , .23D0 , .18D0 , .16D0 , .14D0 , .1D0 , .08D0 ,
     &     .05D0 , .02D0 , .015D0 , 4*.011D0 , 3*.005D0 , 0.D0 , 55.D0 ,
     &     50.D0 , 25.D0 , 15.D0 , 15.D0 , 14.D0 , 12.D0 , 10.D0 ,
     &     7.D0 , 6.D0 , 4.D0 , 3.3D0 , 2.8D0 , 2.4D0 , 2.D0 , 1.8D0 ,
     &     1.55D0 , 1.3D0 , .95D0 , .75D0 , 0.D0 , 3.3D0 , 3.D0 ,
     &     1.5D0 , 1.D0 , .7D0 , .4D0 , .35D0 , .4D0 , .25D0 , .18D0 ,
     &     .08D0 , .04D0 , .03D0 , .023D0 , .016D0 , .014D0 , .01D0 ,
     &     .008D0 , .006D0 , .005D0/
      DATA SPIkpe/0.D0 , 215.D0 , 193.D0 , 170.D0 , 148.D0 , 113.D0 ,
     &     97.D0 , 84.D0 , 78.D0 , 68.D0 , 64.D0 , 61.D0 , 46.D0 ,
     &     36.D0 , 31.3D0 , 28.5D0 , 25.7D0 , 22.6D0 , 21.4D0 , 20.7D0 ,
     &     19.9D0 , 9*0.D0 , 2.D0 , 2.5D0 , .2D0 , 19*0.D0 , .3D0 ,
     &     1.4D0 , 2.2D0 , 1.2D0 , 1.1D0 , 1.D0 , .8D0 , .6D0 , .5D0 ,
     &     .4D0 , .3D0 , 10*0.D0 , .3D0 , 1.4D0 , 2.2D0 , 1.2D0 ,
     &     1.1D0 , 1.D0 , .8D0 , .6D0 , .5D0 , .4D0 , .3D0 , 10*0.D0 ,
     &     .3D0 , 1.4D0 , 2.2D0 , 1.2D0 , 1.1D0 , 1.D0 , .8D0 , .6D0 ,
     &     .5D0 , .4D0 , .3D0 , 10*0.D0 , .3D0 , 1.4D0 , 2.2D0 , 1.2D0 ,
     &     1.1D0 , 1.D0 , .8D0 , .6D0 , .5D0 , .4D0 , .3D0 , 9*0.D0 ,
     &     .6D0 , 2.5D0 , 5.D0 , 5.2D0 , 5.1D0 , 5.4D0 , 5.8D0 , 2.8D0 ,
     &     2.1D0 , 1.8D0 , 1.6D0 , 1.2D0 , 13*0.D0 , 1.3D0 , 1.5D0 ,
     &     2.D0 , 2.5D0 , 2.5D0 , 2.3D0 , 1.8D0 , 1.4D0 , 13*0.D0 ,
     &     1.3D0 , 1.5D0 , 2.D0 , 2.5D0 , 2.5D0 , 2.3D0 , 1.8D0 ,
     &     1.4D0 , 13*0.D0 , 1.3D0 , 1.5D0 , 2.D0 , 2.5D0 , 2.5D0 ,
     &     2.3D0 , 1.8D0 , 1.4D0 , 13*0.D0 , 1.3D0 , 1.5D0 , 2.D0 ,
     &     2.5D0 , 2.5D0 , 2.3D0 , 1.8D0 , 1.4D0 , 14*0.D0 , .2D0 ,
     &     .5D0 , 1.1D0 , 1.6D0 , 1.4D0 , 1.1D0 , .9D0 , 14*0.D0 ,
     &     .2D0 , .5D0 , 1.1D0 , 1.6D0 , 1.4D0 , 1.1D0 , .9D0 ,
     &     14*0.D0 , .2D0 , .5D0 , 1.1D0 , 1.6D0 , 1.4D0 , 1.1D0 ,
     &     .9D0 , 14*0.D0 , .2D0 , .5D0 , 1.1D0 , 1.6D0 , 1.4D0 ,
     &     1.1D0 , .9D0 , 17*0.D0 , .3D0 , 1.6D0 , 2.6D0 , 3.6D0 ,
     &     17*0.D0 , .3D0 , 1.6D0 , 2.6D0 , 3.6D0 , 17*0.D0 , .3D0 ,
     &     1.6D0 , 2.6D0 , 3.6D0 , 17*0.D0 , .3D0 , 1.6D0 , 2.6D0 ,
     &     3.6D0/
C***************   ap - n - data                                       *
      DATA SAPnel/0.D0 , 176.D0 , 160.D0 , 105.D0 , 75.D0 , 68.D0 ,
     &     65.D0 , 50.D0 , 50.D0 , 43.D0 , 42.D0 , 40.5D0 , 35.D0 ,
     &     30.D0 , 28.D0 , 25.D0 , 22.D0 , 21.D0 , 20.D0 , 18.D0 ,
     &     17.D0 , 11*0.D0 , .05D0 , .15D0 , .18D0 , .2D0 , .2D0 ,
     &     .3D0 , .4D0 , .6D0 , .7D0 , .85D0 , 0.D0 , 1.D0 , .9D0 ,
     &     .46D0 , .3D0 , .23D0 , .18D0 , .16D0 , .14D0 , .1D0 , .08D0 ,
     &     .05D0 , .02D0 , .015D0 , 4*.011D0 , 3*.005D0 , 0.D0 , 3.3D0 ,
     &     3.D0 , 1.5D0 , 1.D0 , .7D0 , .4D0 , .35D0 , .4D0 , .25D0 ,
     &     .18D0 , .08D0 , .04D0 , .03D0 , .023D0 , .016D0 , .014D0 ,
     &     .01D0 , .008D0 , .006D0 , .005D0/
      DATA SPIkpz/0.D0 , 215.D0 , 193.D0 , 170.D0 , 148.D0 , 113.D0 ,
     &     97.D0 , 84.D0 , 78.D0 , 68.D0 , 64.D0 , 61.D0 , 46.D0 ,
     &     36.D0 , 31.3D0 , 28.5D0 , 25.7D0 , 22.6D0 , 21.4D0 , 20.7D0 ,
     &     19.9D0 , 9*0.D0 , 2.4D0 , .2D0 , 20*0.D0 , 1.8D0 , 2.8D0 ,
     &     3.6D0 , 2.3D0 , 1.8D0 , 1.5D0 , 1.3D0 , 1.D0 , .7D0 , .5D0 ,
     &     .3D0 , 10*0.D0 , 1.8D0 , 2.8D0 , 3.6D0 , 2.3D0 , 1.8D0 ,
     &     1.5D0 , 1.3D0 , 1.D0 , .7D0 , .5D0 , .3D0 , 10*0.D0 , 1.8D0 ,
     &     2.8D0 , 3.6D0 , 2.3D0 , 1.8D0 , 1.5D0 , 1.3D0 , 1.D0 , .7D0 ,
     &     .5D0 , .3D0 , 10*0.D0 , 1.8D0 , 2.8D0 , 3.6D0 , 2.3D0 ,
     &     1.8D0 , 1.5D0 , 1.3D0 , 1.D0 , .7D0 , .5D0 , .3D0 , 13*0.D0 ,
     &     5.2D0 , 8.7D0 , 11.4D0 , 14.D0 , 11.9D0 , 7.6D0 , 6.D0 ,
     &     5.D0 , 13*0.D0 , 5.2D0 , 8.7D0 , 11.4D0 , 14.D0 , 11.9D0 ,
     &     7.6D0 , 6.D0 , 5.D0 , 18*0.D0 , 1.D0 , 4.9D0 , 8.5D0 ,
     &     18*0.D0 , 1.D0 , 4.9D0 , 8.5D0 , 15*0.D0 , 1.9D0 , 2.3D0 ,
     &     4.D0 , 6.5D0 , 5.2D0 , 3.4D0 , 15*0.D0 , 1.9D0 , 2.3D0 ,
     &     4.D0 , 6.5D0 , 5.2D0 , 3.4D0 , 15*0.D0 , 1.9D0 , 2.3D0 ,
     &     4.D0 , 6.5D0 , 5.2D0 , 3.4D0/
C                                                                      *
C                                                                      *
C***************   an - p - data                                       *
C                                                                      *
      DATA SANpel/0.D0 , 176.D0 , 160.D0 , 105.D0 , 75.D0 , 68.D0 ,
     &     65.D0 , 50.D0 , 50.D0 , 43.D0 , 42.D0 , 40.5D0 , 35.D0 ,
     &     30.D0 , 28.D0 , 25.D0 , 22.D0 , 21.D0 , 20.D0 , 18.D0 ,
     &     17.D0 , 11*0.D0 , .05D0 , .15D0 , .18D0 , .2D0 , .2D0 ,
     &     .3D0 , .4D0 , .6D0 , .7D0 , .85D0 , 0.D0 , 1.D0 , .9D0 ,
     &     .46D0 , .3D0 , .23D0 , .18D0 , .16D0 , .14D0 , .1D0 , .08D0 ,
     &     .05D0 , .02D0 , .015D0 , 4*.011D0 , 3*.005D0 , 0.D0 , 3.3D0 ,
     &     3.D0 , 1.5D0 , 1.D0 , .7D0 , .4D0 , .35D0 , .4D0 , .25D0 ,
     &     .18D0 , .08D0 , .04D0 , .03D0 , .023D0 , .016D0 , .014D0 ,
     &     .01D0 , .008D0 , .006D0 , .005D0/
      DATA SPIkpf/0.D0 , 215.D0 , 193.D0 , 170.D0 , 148.D0 , 113.D0 ,
     &     97.D0 , 84.D0 , 78.D0 , 68.D0 , 64.D0 , 61.D0 , 46.D0 ,
     &     36.D0 , 31.3D0 , 28.5D0 , 25.7D0 , 22.6D0 , 21.4D0 , 20.7D0 ,
     &     19.9D0 , 9*0.D0 , 2.4D0 , .2D0 , 20*0.D0 , 1.8D0 , 2.8D0 ,
     &     3.6D0 , 2.3D0 , 1.8D0 , 1.5D0 , 1.3D0 , 1.D0 , .7D0 , .5D0 ,
     &     .3D0 , 10*0.D0 , 1.8D0 , 2.8D0 , 3.6D0 , 2.3D0 , 1.8D0 ,
     &     1.5D0 , 1.3D0 , 1.D0 , .7D0 , .5D0 , .3D0 , 10*0.D0 , 1.8D0 ,
     &     2.8D0 , 3.6D0 , 2.3D0 , 1.8D0 , 1.5D0 , 1.3D0 , 1.D0 , .7D0 ,
     &     .5D0 , .3D0 , 10*0.D0 , 1.8D0 , 2.8D0 , 3.6D0 , 2.3D0 ,
     &     1.8D0 , 1.5D0 , 1.3D0 , 1.D0 , .7D0 , .5D0 , .3D0 , 13*0.D0 ,
     &     5.2D0 , 8.7D0 , 11.4D0 , 14.D0 , 11.9D0 , 7.6D0 , 6.D0 ,
     &     5.D0 , 13*0.D0 , 5.2D0 , 8.7D0 , 11.4D0 , 14.D0 , 11.9D0 ,
     &     7.6D0 , 6.D0 , 5.D0 , 18*0.D0 , 1.D0 , 4.9D0 , 8.5D0 ,
     &     18*0.D0 , 1.D0 , 4.9D0 , 8.5D0 , 15*0.D0 , 1.9D0 , 2.3D0 ,
     &     4.D0 , 6.5D0 , 5.2D0 , 3.4D0 , 15*0.D0 , 1.9D0 , 2.3D0 ,
     &     4.D0 , 6.5D0 , 5.2D0 , 3.4D0 , 15*0.D0 , 1.9D0 , 2.3D0 ,
     &     4.D0 , 6.5D0 , 5.2D0 , 3.4D0/
      DATA SPKp15/0.D0 , 20.D0 , 14.D0 , 12.D0 , 11.5D0 , 10.D0 , 8.D0 ,
     &     7.D0 , 6.D0 , 5.5D0 , 5.3D0 , 5.D0 , 4.5D0 , 4.4D0 , 3.8D0 ,
     &     3.D0 , 2.8D0 , 0.D0 , .5D0 , 1.15D0 , 2.D0 , 1.3D0 , .8D0 ,
     &     .45D0 , 10*0.D0 , 3*0.D0 , 0.9D0 , 2.5D0 , 3.D0 , 2.5D0 ,
     &     2.3D0 , 2.D0 , 1.7D0 , 1.5D0 , 1.2D0 , .9D0 , .6D0 , .45D0 ,
     &     .21D0 , .2D0 , 3*0.D0 , 0.9D0 , 2.5D0 , 3.D0 , 2.5D0 ,
     &     2.3D0 , 2.D0 , 1.7D0 , 1.5D0 , 1.2D0 , .9D0 , .6D0 , .45D0 ,
     &     .21D0 , .2D0 , 4*0.D0 , 1.D0 , 2.1D0 , 2.6D0 , 2.3D0 ,
     &     2.1D0 , 1.8D0 , 1.7D0 , 1.4D0 , 1.2D0 , 1.05D0 , .9D0 ,
     &     .66D0 , .5D0 , 7*0.D0 , .3D0 , 1.D0 , 1.D0 , .9D0 , .7D0 ,
     &     .4D0 , .30D0 , .2D0 , 11*0.D0 , .1D0 , 1.D0 , 2.2D0 , 3.5D0 ,
     &     4.20D0 , 4.55D0 , 4.85D0 , 4.9D0 , 10*0.D0 , .2D0 , .7D0 ,
     &     1.6D0 , 2.5D0 , 2.2D0 , 1.71D0 , 1.6D0 , 6*0.D0 , 1.4D0 ,
     &     3.8D0 , 5.D0 , 4.7D0 , 4.4D0 , 4.D0 , 3.5D0 , 2.85D0 ,
     &     2.35D0 , 2.01D0 , 1.8D0 , 12*0.D0 , .1D0 , .8D0 , 2.05D0 ,
     &     3.31D0 , 3.5D0 , 12*0.D0 , .034D0 , .20D0 , .75D0 , 1.04D0 ,
     &     1.24D0/
      DATA SPKp16/0.D0 , 4.D0 , 9.5D0 , 20.D0 , 13.D0 , 9.5D0 , 6.D0 ,
     &     4.4D0 , 3.D0 , 2.4D0 , 2.D0 , 1.4D0 , 1.2D0 , 1.D0 , .9D0 ,
     &     .7D0 , .6D0 , 0.D0 , 4.5D0 , 6.D0 , 5.D0 , 2.5D0 , 2.D0 ,
     &     1.7D0 , 2.1D0 , 1.9D0 , .9D0 , .5D0 , .3D0 , .24D0 , .2D0 ,
     &     .18D0 , .1D0 , .09D0 , 0.D0 , 1.8D0 , 2.D0 , 1.1D0 , .9D0 ,
     &     .5D0 , .5D0 , .4D0 , .4D0 , .2D0 , .1D0 , .06D0 , .05D0 ,
     &     .04D0 , .03D0 , .02D0 , .02D0 , 0.D0 , 1.5D0 , 2.D0 , .9D0 ,
     &     1.1D0 , .4D0 , .6D0 , .7D0 , .65D0 , .3D0 , .17D0 , .1D0 ,
     &     .08D0 , .07D0 , .06D0 , .04D0 , .03D0 , 0.D0 , .56D0 ,
     &     1.29D0 , 2.26D0 , 1.01D0 , .64D0 , .37D0 , 14*0.D0 , 1.13D0 ,
     &     2.61D0 , 2.91D0 , 2.58D0 , 2.35D0 , 2.02D0 , 1.91D0 ,
     &     1.57D0 , 1.35D0 , 1.29D0 , 1.01D0 , .74D0 , .65D0 , 3*0.D0 ,
     &     1.0D0 , 3.03D0 , 3.36D0 , 2.8D0 , 2.58D0 , 2.24D0 , 1.91D0 ,
     &     1.68D0 , 1.35D0 , 1.01D0 , .67D0 , .5D0 , .24D0 , .23D0 ,
     &     3*0.D0 , 1.0D0 , 3.03D0 , 3.36D0 , 2.8D0 , 2.58D0 , 2.24D0 ,
     &     1.91D0 , 1.68D0 , 1.35D0 , 1.01D0 , .67D0 , .5D0 , .24D0 ,
     &     .23D0 , 7*0.D0 , .34D0 , 1.12D0 , 1.12D0 , 1.01D0 , .78D0 ,
     &     .45D0 , .39D0 , .22D0 , .07D0 , 7*0.D0 , 1.71D0 , 4.26D0 ,
     &     5.6D0 , 5.57D0 , 4.93D0 , 4.48D0 , 3.92D0 , 3.19D0 , 2.63D0 ,
     &     2.25D0 , 2.D0 , 10*0.D0 , .22D0 , .8D0 , .75D0 , 1.D0 ,
     &     1.3D0 , 1.5D0 , 1.3D0 , 13*0.D0 , .1D0 , .3D0 , .7D0 , 1.D0 ,
     &     13*0.D0 , .1D0 , .3D0 , .7D0 , 1.D0 , 9*0.D0 , .11D0 ,
     &     1.72D0 , 2.69D0 , 3.92D0 , 4.76D0 , 5.10D0 , 5.44D0 , 5.3D0 ,
     &     5*0.D0 , 9.2D0 , 4.7D0 , 1.9D0 , 9*0.D0 , .0D0 , 2.5D0 ,
     &     15.D0 , 21.5D0 , 15.3D0 , 3.D0 , 1.5D0 , 10*0.D0/
      DATA NUReln/9 , 12 , 5*0 , 10 , 14 , 3*0 , 1 , 3 , 5 , 7 , 6*0 ,
     &     2 , 6 , 16 , 5*0 , 10 , 13 , 5*0 , 11 , 12 , 3*0 , 2 , 4 ,
     &     6 , 8 , 6*0 , 3 , 15 , 7 , 5*0/
C=                                               end*block.blkdt3      *
      END BLOCK DATA


subroutine calctends_tl(fields,fields_dt,mype)
!$$$  subprogram documentation block
!                .      .    .                                       .
! subprogram:    calctends_tl       tlm of calctends
!   prgmmr: kleist           org: np20                date: 2005-09-29
!
! abstract: TLM of routine that compute tendencies for pressure, Tv, u, v
!
! program history log:
!   2005-09-29  kleist
!   2005-10-17  kleist - changes to improve computational efficiency
!   2005-11-21  kleist - add tracer tendencies, use new module
!   2006-04-12  treadon - replace sigi with bk5
!   2006-04-21  kleist - add divergence tendency parts
!   2006-07-31  kleist - changes to use ps instead of ln(ps)
!   2006-09-21  kleist - add rescaling to divergence tendency formulation
!   2006-10-04  rancic - correct bug in tracer advection terms
!   2007-04-16  kleist - move constraint specific items elsewhere
!   2007-05-08  kleist - add bits for fully generalized vertical coordinate
!   2007-06-21  rancic - add pbl
!   2007-07-26  cucurull - add 3d pressure pri in argument list ;
!                          move getprs_tl outside calctends_tl;
!                          call getprs_horiz_tl;
!                          remove ps from argument list
!   2007-08-08  derber - optimize
!   2008-06-05  safford - rm unused uses
!   2009-08-20  parrish - replace curvfct with curvx, curvy.  this allows tendency computation to
!                          work for any general orthogonal coordinate.
!   2010-11-03  derber - moved threading calculations to gridmod and modified
!   2011-05-01  todling - cwmr no longer in guess-grids; use metguess bundle now
!   2011-12-02  zhu     - add safe-guard for the case when there is no entry in the metguess table
!   2012-03-11  tong    - added condition to calcuate cw_t
!   2013-10-19  todling - revamp interface (pass all in bundles); derivatives and
!                         guess fields also in bundles
!   2013-10-28  todling - rename p3d to prse
!   2014-06-05  eliu    - move location to get cw index(icw) from sv table; add condition
!                         to get pointer for cw
!
! usage:
!   input argument list:
!     fields    - bundle holding relevant fields
!     mype      - task id
!
!   output argument list:
!     fields_dt - bundle holding related time tendencies
!
!   notes:
!     TLM check performed & verified on 2005-09-29 by d. kleist
!
! attributes:
!   language: f90
!   machine:  ibm RS/6000 SP
!
!$$$
  use kinds,only: r_kind,i_kind
  use gridmod, only: lat2,lon2,nsig,istart,nlat,idvc5,bk5,&
      wrf_nmm_regional,nems_nmmb_regional,eta2_ll,regional,nthreads,jtstart,jtstop
  use constants, only: zero,half,two,rd,rcp
  use derivsmod, only: cwgues
  use tendsmod, only: what9,prsth9,r_prsum9,prdif9,r_prdif9,pr_xsum9,pr_xdif9,&
      pr_ysum9,pr_ydif9,curvx,curvy,coriolis
  use guess_grids, only: ntguessig,ges_teta,ges_prsi
  use gsi_metguess_mod, only: gsi_metguess_get,gsi_metguess_bundle
  use gsi_bundlemod, only: gsi_bundlegetpointer
  use gsi_bundlemod, only: gsi_bundle
  use gsi_bundlemod, only: gsi_bundledup
  use gsi_bundlemod, only: gsi_bundleinquire
  use gsi_bundlemod, only: gsi_bundledestroy
  use mpeu_util, only: die, getindex
  use derivsmod, only: gsi_xderivative_bundle
  use derivsmod, only: gsi_yderivative_bundle
  implicit none

! Declare passed variables
  type(gsi_bundle) :: fields
  type(gsi_bundle) :: fields_dt
  integer(i_kind),intent(in) :: mype

! Declare local variables
  character(len=*),parameter::myname='calctends_tl'
  real(r_kind),dimension(:,:,:),pointer :: u_t,v_t,t_t,q_t,oz_t,cw_t
  real(r_kind),dimension(:,:,:),pointer :: p_t
  real(r_kind),dimension(:,:,:),pointer :: pri
  real(r_kind),dimension(:,:,:),pointer :: u,v,t,q,oz,cw
  real(r_kind),dimension(:,:,:),pointer :: u_x,u_y,v_x,v_y,t_x,t_y
  real(r_kind),dimension(:,:,:),pointer :: q_x,q_y,oz_x,oz_y,cw_x,cw_y
  real(r_kind),dimension(:,:)  ,pointer :: ps_x,ps_y
  real(r_kind),dimension(:,:,:),pointer :: pri_x,pri_y
  real(r_kind),dimension(lat2,lon2,nsig+1):: prsth,what
  real(r_kind),dimension(lat2,lon2,nsig):: prsum,prdif,pr_xsum,pr_xdif,&
       pr_ysum,pr_ydif
  real(r_kind),dimension(lat2,lon2):: sumkm1,sumvkm1,sum2km1,sum2vkm1
  real(r_kind),dimension(lat2,lon2,nsig):: t_thor9

  real(r_kind) tmp,tmp2,tmp3,sumk,sumvk,sum2k,sum2vk,uduvdv
  integer(i_kind) i,j,k,ix,it,kk,istatus,n_actual_clouds,ier,icw
  logical ihave_xtra_derivatives
  character(len=10),allocatable,dimension(:)::fvars2d,fvars3d

  type(gsi_bundle) :: xderivative
  type(gsi_bundle) :: yderivative

  real(r_kind),pointer,dimension(:,:,:) :: ges_u=>NULL()
  real(r_kind),pointer,dimension(:,:,:) :: ges_v=>NULL()
  real(r_kind),pointer,dimension(:,:,:) :: ges_tv=>NULL()
  real(r_kind),pointer,dimension(:,:,:) :: ges_q =>NULL()
  real(r_kind),pointer,dimension(:,:,:) :: ges_oz=>NULL()
  real(r_kind),pointer,dimension(:,:,:) :: ges_cwmr=>NULL()

  real(r_kind),pointer,dimension(:,:,:) :: ges_u_lon=>NULL()
  real(r_kind),pointer,dimension(:,:,:) :: ges_v_lon=>NULL()
  real(r_kind),pointer,dimension(:,:,:) :: ges_tv_lon=>NULL()
  real(r_kind),pointer,dimension(:,:,:) :: ges_q_lon =>NULL()
  real(r_kind),pointer,dimension(:,:,:) :: ges_oz_lon=>NULL()
  real(r_kind),pointer,dimension(:,:,:) :: ges_cw_lon=>NULL()

  real(r_kind),pointer,dimension(:,:,:) :: ges_u_lat=>NULL()
  real(r_kind),pointer,dimension(:,:,:) :: ges_v_lat=>NULL()
  real(r_kind),pointer,dimension(:,:,:) :: ges_tv_lat=>NULL()
  real(r_kind),pointer,dimension(:,:,:) :: ges_q_lat =>NULL()
  real(r_kind),pointer,dimension(:,:,:) :: ges_oz_lat=>NULL()
  real(r_kind),pointer,dimension(:,:,:) :: ges_cw_lat=>NULL()

! linearized about guess solution, so set it flag accordingly
  it=ntguessig

  if(fields%n2d>0) allocate(fvars2d(fields%n2d))
  if(fields%n3d>0) allocate(fvars3d(fields%n3d))
  call gsi_bundleinquire (fields,'shortnames::2d',fvars2d,istatus)
  call gsi_bundleinquire (fields,'shortnames::3d',fvars3d,istatus)
  icw=getindex(fvars3d,'cw')

  ier=0
  call gsi_bundlegetpointer(fields,'u',   u,   istatus);ier=istatus+ier
  call gsi_bundlegetpointer(fields,'v',   v,   istatus);ier=istatus+ier
  call gsi_bundlegetpointer(fields,'tv',  t,   istatus);ier=istatus+ier
  call gsi_bundlegetpointer(fields,'q',   q,   istatus);ier=istatus+ier
  call gsi_bundlegetpointer(fields,'oz' , oz,  istatus);ier=istatus+ier
  if (icw>0) &
  call gsi_bundlegetpointer(fields,'cw' , cw,  istatus);ier=istatus+ier
  call gsi_bundlegetpointer(fields,'prse',pri, istatus);ier=istatus+ier
  if(ier/=0) then
     write(6,*) myname,': pointers not found on input, ier=', ier
     call stop2(999)
  endif

  ier=0
  call gsi_bundlegetpointer(fields_dt,'u',   u_t, istatus);ier=istatus+ier
  call gsi_bundlegetpointer(fields_dt,'v',   v_t, istatus);ier=istatus+ier
  call gsi_bundlegetpointer(fields_dt,'tv',  t_t, istatus);ier=istatus+ier
  call gsi_bundlegetpointer(fields_dt,'q',   q_t, istatus);ier=istatus+ier
  call gsi_bundlegetpointer(fields_dt,'oz' , oz_t,istatus);ier=istatus+ier
  if (icw>0) &
  call gsi_bundlegetpointer(fields_dt,'cw' , cw_t,istatus);ier=istatus+ier
  call gsi_bundlegetpointer(fields_dt,'prse',p_t ,istatus);ier=istatus+ier
  if(ier/=0) then
     write(6,*) myname,': pointers not found on tendency, ier=', ier
     call stop2(999)
  endif

  ier=0
  call gsi_bundlegetpointer(gsi_metguess_bundle(it),'u' ,ges_u, istatus);ier=istatus+ier
  call gsi_bundlegetpointer(gsi_metguess_bundle(it),'v' ,ges_v, istatus);ier=istatus+ier
  call gsi_bundlegetpointer(gsi_metguess_bundle(it),'tv',ges_tv,istatus);ier=istatus+ier
  call gsi_bundlegetpointer(gsi_metguess_bundle(it),'q', ges_q ,istatus);ier=istatus+ier
  call gsi_bundlegetpointer(gsi_metguess_bundle(it),'oz',ges_oz,istatus);ier=istatus+ier
  if(ier/=0) then
     write(6,*) myname, ': pointers not found in met-guess, ier=', ier
     call stop2(999)
  endif

  ier=0
  call gsi_bundlegetpointer(gsi_xderivative_bundle(it),'u' ,ges_u_lon, istatus);ier=istatus+ier
  call gsi_bundlegetpointer(gsi_xderivative_bundle(it),'v' ,ges_v_lon, istatus);ier=istatus+ier
  call gsi_bundlegetpointer(gsi_xderivative_bundle(it),'tv',ges_tv_lon,istatus);ier=istatus+ier
  call gsi_bundlegetpointer(gsi_xderivative_bundle(it),'q', ges_q_lon ,istatus);ier=istatus+ier
  call gsi_bundlegetpointer(gsi_xderivative_bundle(it),'oz',ges_oz_lon,istatus);ier=istatus+ier
  call gsi_bundlegetpointer(gsi_xderivative_bundle(it),'cw',ges_cw_lon,istatus);ier=istatus+ier
  if(ier/=0) then
     write(6,*) myname, ': pointers not found in lon-derivatives, ier=', ier
     call stop2(999)
  endif

  ier=0
  call gsi_bundlegetpointer(gsi_yderivative_bundle(it),'u' ,ges_u_lat, istatus);ier=istatus+ier
  call gsi_bundlegetpointer(gsi_yderivative_bundle(it),'v' ,ges_v_lat, istatus);ier=istatus+ier
  call gsi_bundlegetpointer(gsi_yderivative_bundle(it),'tv',ges_tv_lat,istatus);ier=istatus+ier
  call gsi_bundlegetpointer(gsi_yderivative_bundle(it),'q', ges_q_lat ,istatus);ier=istatus+ier
  call gsi_bundlegetpointer(gsi_yderivative_bundle(it),'oz',ges_oz_lat,istatus);ier=istatus+ier
  call gsi_bundlegetpointer(gsi_yderivative_bundle(it),'cw',ges_cw_lat,istatus);ier=istatus+ier
  if(ier/=0) then
     write(6,*) myname, ': pointers not found in lat-derivatives, ier=', ier
     call stop2(999)
  endif

! Get pointer to could water mixing ratio
  call gsi_metguess_get('clouds::3d',n_actual_clouds,ier)
  if (n_actual_clouds>0) then
     call gsi_bundlegetpointer (gsi_metguess_bundle(it),'cw',ges_cwmr,istatus)
     if (istatus/=0) then
        if (regional) then
           ges_cwmr => cwgues     ! temporily, revise after moist physics is ready
        else
           call die('setuppcp','cannot get pointer to cwmr, istatus =',istatus)
        end if
     end if
  else
     ges_cwmr => cwgues
  end if

! preliminaries:
  ihave_xtra_derivatives=.false.
  ier=0
  call gsi_bundledup ( fields, xderivative, 'lon-derivatives', istatus )
  ier=ier+istatus
  call gsi_bundledup ( fields, yderivative, 'lat-derivatives', istatus )
  ier=ier+istatus
  if(ier==0) then
    ihave_xtra_derivatives=.true.
  else
    call die(myname,': trouble creating temporary space for derivatives',ier)
  endif

  call get_derivatives( fields, xderivative, yderivative )

  call gsi_bundlegetpointer(xderivative,'ps'  , ps_x,istatus)
  call gsi_bundlegetpointer(xderivative,'u'   ,  u_x,istatus)
  call gsi_bundlegetpointer(xderivative,'v'   ,  v_x,istatus)
  call gsi_bundlegetpointer(xderivative,'tv'  ,  t_x,istatus)
  call gsi_bundlegetpointer(xderivative,'q'   ,  q_x,istatus)
  call gsi_bundlegetpointer(xderivative,'oz'  , oz_x,istatus)
  call gsi_bundlegetpointer(xderivative,'cw'  , cw_x,istatus)
  call gsi_bundlegetpointer(xderivative,'prse',pri_x,istatus)

  call gsi_bundlegetpointer(yderivative,'ps'  , ps_y,istatus)
  call gsi_bundlegetpointer(yderivative,'u'   ,  u_y,istatus)
  call gsi_bundlegetpointer(yderivative,'v'   ,  v_y,istatus)
  call gsi_bundlegetpointer(yderivative,'tv'  ,  t_y,istatus)
  call gsi_bundlegetpointer(yderivative,'q'   ,  q_y,istatus)
  call gsi_bundlegetpointer(yderivative,'oz'  , oz_y,istatus)
  call gsi_bundlegetpointer(yderivative,'cw'  , cw_y,istatus)
  call gsi_bundlegetpointer(yderivative,'prse',pri_y,istatus)

  call getprs_horiz_tl(ps_x,ps_y,pri,pri_x,pri_y)

!$omp parallel do private(i,j,k,kk,tmp,tmp2,uduvdv, &
!$omp                  tmp3,sumk,sumvk,sum2k,sum2vk,ix)
  do kk=1,nthreads

    do k=1,nsig
      do j=jtstart(kk),jtstop(kk)
        do i=1,lat2
           prsum  (i,j,k)=pri  (i,j,k)+pri  (i,j,k+1)
           prdif  (i,j,k)=pri  (i,j,k)-pri  (i,j,k+1)
           pr_xsum(i,j,k)=pri_x(i,j,k)+pri_x(i,j,k+1)
           pr_xdif(i,j,k)=pri_x(i,j,k)-pri_x(i,j,k+1)
           pr_ysum(i,j,k)=pri_y(i,j,k)+pri_y(i,j,k+1)
           pr_ydif(i,j,k)=pri_y(i,j,k)-pri_y(i,j,k+1)
        end do
      end do
    end do

!   Compute horizontal part of tendency for 3d pressure

    do j=jtstart(kk),jtstop(kk)
      do i=1,lat2
        prsth(i,j,nsig+1)=zero
      end do
    end do
    do k=nsig,1,-1
      do j=jtstart(kk),jtstop(kk)
        do i=1,lat2
           prsth(i,j,k)=prsth(i,j,k+1) - ( u(i,j,k)*pr_xdif9(i,j,k) + &
              ges_u(i,j,k)*pr_xdif(i,j,k) + v(i,j,k)*pr_ydif9(i,j,k) + &
              ges_v(i,j,k)*pr_ydif(i,j,k) + &
              (u_x(i,j,k) + v_y(i,j,k))*(prdif9(i,j,k)) + &
              (ges_u_lon(i,j,k) + ges_v_lat(i,j,k))*(prdif(i,j,k)) )
        end do
      end do
    end do

!   Get horizontal part of temperature tendency for vertical velocity term

    do k=1,nsig
      do j=jtstart(kk),jtstop(kk)
        do i=1,lat2
           tmp=rd*ges_tv(i,j,k)*r_prsum9(i,j,k)
           t_t(i,j,k)=-u(i,j,k)*ges_tv_lon(i,j,k) - ges_u(i,j,k)*t_x(i,j,k) - &
              v(i,j,k)*ges_tv_lat(i,j,k) - ges_v(i,j,k)*t_y(i,j,k) +          &
              tmp*rcp*( ges_u(i,j,k)*pr_xsum(i,j,k) + &
              u(i,j,k)*pr_xsum9(i,j,k) + &
              ges_v(i,j,k)*pr_ysum(i,j,k) + &
              v(i,j,k)*pr_ysum9(i,j,k) + &
              prsth(i,j,k) + prsth(i,j,k+1)) + &
              rcp*( ges_u(i,j,k)*pr_xsum9(i,j,k) + &
              ges_v(i,j,k)*pr_ysum9(i,j,k) + &
              prsth9(i,j,k)+prsth9(i,j,k+1) ) * &
              ( rd*t(i,j,k)*r_prsum9(i,j,k) - tmp*prsum(i,j,k)*r_prsum9(i,j,k) )

        end do
      end do
    end do

!   calculate vertical velocity term:  z(dp/dz) (zero at top/bottom interfaces)
!   if running global, and there is a c(k) coefficient, we call the vvel subroutine

    if ( (.not.regional) .AND. (idvc5==3)) then

!     Get horizontal part of temperature tendency for vertical velocity term

      do k=1,nsig
        do j=jtstart(kk),jtstop(kk)
           do i=1,lat2
              tmp=rd*ges_tv(i,j,k)*r_prsum9(i,j,k)

              t_thor9(i,j,k)=-ges_u(i,j,k)*ges_tv_lon(i,j,k) - &
                   ges_v(i,j,k)*ges_tv_lat(i,j,k)
              t_thor9(i,j,k)=t_thor9(i,j,k) -tmp*rcp * ( ges_u(i,j,k)*pr_xsum9(i,j,k) + &
                 ges_v(i,j,k)*pr_ysum9(i,j,k) + &
                 prsth9(i,j,k) + prsth9(i,j,k+1) )
           end do
        end do
      end do
      call getvvel_tl(t,t_t,t_thor9,prsth,prdif,what,jtstart(kk),jtstop(kk))
    else
      if(wrf_nmm_regional.or.nems_nmmb_regional) then
        do k=2,nsig
           do j=jtstart(kk),jtstop(kk)
              do i=1,lat2
                 what(i,j,k)=prsth(i,j,k)-eta2_ll(k)*prsth(i,j,1)
              end do
           end do
        end do
      else
        do k=2,nsig
           do j=jtstart(kk),jtstop(kk)
              do i=1,lat2
                 what(i,j,k)=prsth(i,j,k)-bk5    (k)*prsth(i,j,1)
              end do
           end do
        end do
      end if
    end if

!   top/bottom boundary condition:

    do j=jtstart(kk),jtstop(kk)
      do i=1,lat2
        what(i,j,1)=zero
        what(i,j,nsig+1)=zero
      enddo
    enddo

!   load actual dp/dt

    do k=1,nsig+1
      do j=jtstart(kk),jtstop(kk)
        do i=1,lat2
           p_t(i,j,k)=prsth(i,j,k)-what(i,j,k)
        end do
      end do
    end do

!   before big k loop, zero out the km1 summation arrays

    do j=jtstart(kk),jtstop(kk)
      do i=1,lat2
        sumkm1  (i,j)=zero
        sum2km1 (i,j)=zero
        sumvkm1 (i,j)=zero
        sum2vkm1(i,j)=zero
      end do
    end do

!   Compute terms for tendencies of wind components & Temperature

    do k=1,nsig
      do j=jtstart(kk),jtstop(kk)
        do i=1,lat2
           uduvdv=two*(ges_u(i,j,k)*u(i,j,k) + ges_v(i,j,k)*v(i,j,k))
           u_t(i,j,k)=-u(i,j,k)*ges_u_lon(i,j,k) - ges_u(i,j,k)*u_x(i,j,k) - &
              v(i,j,k)*ges_u_lat(i,j,k) - ges_v(i,j,k)*u_y(i,j,k) + &
              coriolis(i,j)*v(i,j,k) + curvx(i,j)*uduvdv
           v_t(i,j,k)=-u(i,j,k)*ges_v_lon(i,j,k) - ges_u(i,j,k)*v_x(i,j,k) - &
              v(i,j,k)*ges_v_lat(i,j,k) - ges_v(i,j,k)*v_y(i,j,k) - &
              coriolis(i,j)*u(i,j,k) + curvy(i,j)*uduvdv

           tmp=rd*ges_tv(i,j,k)*r_prsum9(i,j,k)
           tmp2=rd*t(i,j,k)*r_prsum9(i,j,k)

           u_t(i,j,k) = u_t(i,j,k)-tmp*( pr_xsum(i,j,k) - &
              (prsum(i,j,k)*pr_xsum9(i,j,k)*r_prsum9(i,j,k)) ) - &
              tmp2*pr_xsum9(i,j,k)

           v_t(i,j,k) = v_t(i,j,k)-tmp*( pr_ysum(i,j,k) - &
              (prsum(i,j,k)*pr_ysum9(i,j,k)*r_prsum9(i,j,k)) ) - &
              tmp2*pr_ysum9(i,j,k)

!     vertical flux terms

           if (k > 1) then
              tmp=half*what(i,j,k)*r_prdif9(i,j,k)
              tmp2=half*what9(i,j,k)*r_prdif9(i,j,k)

              u_t(i,j,k) = u_t(i,j,k) - tmp*(ges_u (i,j,k-1)-ges_u (i,j,k)) - &
                 tmp2*( (u(i,j,k-1)-u(i,j,k)) - (ges_u (i,j,k-1)-ges_u (i,j,k))* &
                 prdif(i,j,k)*r_prdif9(i,j,k))
              v_t(i,j,k) = v_t(i,j,k) - tmp*(ges_v (i,j,k-1)-ges_v (i,j,k)) - &
                 tmp2*( (v(i,j,k-1)-v(i,j,k)) - (ges_v (i,j,k-1)-ges_v (i,j,k))* &
                 prdif(i,j,k)*r_prdif9(i,j,k))
              t_t(i,j,k) = t_t(i,j,k) - tmp*(ges_tv(i,j,k-1)-ges_tv(i,j,k)) - &
                 tmp2*( (t(i,j,k-1)-t(i,j,k)) - (ges_tv(i,j,k-1)-ges_tv(i,j,k))* &
                 prdif(i,j,k)*r_prdif9(i,j,k))
           end if
           if (k < nsig) then
              tmp=half*what(i,j,k+1)*r_prdif9(i,j,k)
              tmp2=half*what9(i,j,k+1)*r_prdif9(i,j,k)
              u_t(i,j,k) = u_t(i,j,k) - tmp*(ges_u (i,j,k)-ges_u (i,j,k+1)) - &
                 tmp2*( (u(i,j,k)-u(i,j,k+1)) - (ges_u (i,j,k)-ges_u (i,j,k+1))* &
                 prdif(i,j,k)*r_prdif9(i,j,k))
              v_t(i,j,k) = v_t(i,j,k) - tmp*(ges_v (i,j,k)-ges_v (i,j,k+1)) - &
                 tmp2*( (v(i,j,k)-v(i,j,k+1)) - (ges_v (i,j,k)-ges_v (i,j,k+1))* &
                 prdif(i,j,k)*r_prdif9(i,j,k))
              t_t(i,j,k) = t_t(i,j,k) - tmp*(ges_tv(i,j,k)-ges_tv(i,j,k+1)) - &
                 tmp2*( (t(i,j,k)-t(i,j,k+1)) - (ges_tv(i,j,k)-ges_tv(i,j,k+1))* &
                 prdif(i,j,k)*r_prdif9(i,j,k))
           end if
         end do   !end do i
      end do     !end do j

!     first sum to level k-1

      do j=jtstart(kk),jtstop(kk)
        do i=1,lat2
           tmp=rd*t(i,j,k)*r_prsum9(i,j,k)
           tmp2=rd*ges_tv(i,j,k)*r_prsum9(i,j,k)
           tmp3=prdif9(i,j,k)*r_prsum9(i,j,k)

           sumk = sumkm1(i,j) + ( tmp - tmp2*prsum(i,j,k)*r_prsum9(i,j,k) ) * &
              ( pr_xdif9(i,j,k) - ( pr_xsum9(i,j,k)*tmp3 ) )
           sumk = sumk + tmp2*( pr_xdif(i,j,k) - &
              (tmp3 *pr_xsum(i,j,k) + pr_xsum9(i,j,k)*( ( &
              prdif(i,j,k) - tmp3* prsum(i,j,k) )*r_prsum9(i,j,k) ) ) )

           sumvk = sumvkm1(i,j) + ( tmp - tmp2*prsum(i,j,k)*r_prsum9(i,j,k) ) * &
              ( pr_ydif9(i,j,k) - ( pr_ysum9(i,j,k)*tmp3 ) )
           sumvk = sumvk + tmp2*( pr_ydif(i,j,k) - &
              (tmp3*pr_ysum(i,j,k) + pr_ysum9(i,j,k)*( ( &
              prdif(i,j,k) - tmp3* prsum(i,j,k) )*r_prsum9(i,j,k) ) ) )

           sum2k  = sum2km1 (i,j) + t_x(i,j,k)*tmp3 + &
              ges_tv_lon(i,j,k)*( (prdif(i,j,k) - &
              tmp3*prsum(i,j,k))*r_prsum9(i,j,k))

           sum2vk = sum2vkm1(i,j) + t_y(i,j,k)*tmp3 + &
              ges_tv_lat(i,j,k)*( (prdif(i,j,k) - &
              tmp3*prsum(i,j,k))*r_prsum9(i,j,k))

           u_t(i,j,k) = u_t(i,j,k) - sumkm1 (i,j) - rd*sum2km1 (i,j) - &
              sumk  - rd*sum2k
           v_t(i,j,k) = v_t(i,j,k) - sumvkm1(i,j) - rd*sum2vkm1(i,j) - &
              sumvk - rd*sum2vk

! load up the km1 arrays for next k loop

           sumkm1  (i,j)=sumk
           sumvkm1 (i,j)=sumvk
           sum2km1 (i,j)=sum2k
           sum2vkm1(i,j)=sum2vk

        end do !end do i
      end do   !end do j
    end do  !end do k

    call turbl_tl(ges_prsi(1,1,1,it),ges_tv,ges_teta(1,1,1,it),&
               u,v,pri,t,u_t,v_t,t_t,jtstart(kk),jtstop(kk))

    if(.not.wrf_nmm_regional.and..not.nems_nmmb_regional)then
      do k=1,nsig

!       Zero out time derivatives at poles
        do j=jtstart(kk),jtstop(kk)
           do i=1,lat2
              ix=istart(mype+1)+i-2
              if (ix == 1 .or. ix == nlat) then
                 u_t(i,j,k)=zero
                 v_t(i,j,k)=zero
              end if
           end do
        end do

      end do  !end do k
    end if
    do k=1,nsig
      do j=jtstart(kk),jtstop(kk)
        do i=1,lat2
!          tracer advection terms
           q_t (i,j,k) = -u(i,j,k)*ges_q_lon    (i,j,k) - ges_u(i,j,k)*q_x (i,j,k) - &
              v(i,j,k)*ges_q_lat    (i,j,k) - ges_v(i,j,k)*q_y (i,j,k)
           oz_t(i,j,k) = -u(i,j,k)*ges_oz_lon   (i,j,k) - ges_u(i,j,k)*oz_x(i,j,k) - &
              v(i,j,k)*ges_oz_lat   (i,j,k) - ges_v(i,j,k)*oz_y(i,j,k)
           if (icw>0) then
              cw_t(i,j,k) = -u(i,j,k)*ges_cw_lon(i,j,k) - ges_u(i,j,k)*cw_x(i,j,k) - &
                 v(i,j,k)*ges_cw_lat(i,j,k) - ges_v(i,j,k)*cw_y(i,j,k)
           end if
           if(k > 1)then
              tmp=half*what(i,j,k)*r_prdif9(i,j,k)
              tmp2=half*what9(i,j,k)*r_prdif9(i,j,k)
              q_t (i,j,k) = q_t (i,j,k) - tmp*(ges_q   (i,j,k-1)-ges_q   (i,j,k)) - &
                 tmp2*( (q (i,j,k-1)-q (i,j,k)) - (ges_q   (i,j,k-1)-ges_q   (i,j,k))* &
                 prdif(i,j,k)*r_prdif9(i,j,k))
              oz_t(i,j,k) = oz_t(i,j,k) - tmp*(ges_oz  (i,j,k-1)-ges_oz  (i,j,k)) - &
                 tmp2*( (oz(i,j,k-1)-oz(i,j,k)) - (ges_oz  (i,j,k-1)-ges_oz  (i,j,k))* &
                 prdif(i,j,k)*r_prdif9(i,j,k))
              if (icw>0) then
                 cw_t(i,j,k) = cw_t(i,j,k) - tmp*(ges_cwmr(i,j,k-1)-ges_cwmr(i,j,k)) - &
                    tmp2*( (cw(i,j,k-1)-cw(i,j,k)) - (ges_cwmr(i,j,k-1)-ges_cwmr(i,j,k))* &
                    prdif(i,j,k)*r_prdif9(i,j,k))
              end if
           end if
           if(k < nsig)then
              tmp=half*what(i,j,k+1)*r_prdif9(i,j,k)
              tmp2=half*what9(i,j,k+1)*r_prdif9(i,j,k)
              q_t (i,j,k) = q_t (i,j,k) - tmp*(ges_q   (i,j,k)-ges_q   (i,j,k+1)) - &
                 tmp2*( (q (i,j,k)-q (i,j,k+1)) - (ges_q   (i,j,k)-ges_q   (i,j,k+1))* &
                 prdif(i,j,k)*r_prdif9(i,j,k))
              oz_t(i,j,k) = oz_t(i,j,k) - tmp*(ges_oz  (i,j,k)-ges_oz  (i,j,k+1)) - &
                 tmp2*( (oz(i,j,k)-oz(i,j,k+1)) - (ges_oz  (i,j,k)-ges_oz  (i,j,k+1))* &
                 prdif(i,j,k)*r_prdif9(i,j,k))
              if (icw>0) then
                 cw_t(i,j,k) = cw_t(i,j,k) - tmp*(ges_cwmr(i,j,k)-ges_cwmr(i,j,k+1)) - &
                    tmp2*( (cw(i,j,k)-cw(i,j,k+1)) - (ges_cwmr(i,j,k)-ges_cwmr(i,j,k+1))* &
                    prdif(i,j,k)*r_prdif9(i,j,k))
              end if
           end if
        end do
      end do
    end do

  end do
  if (ihave_xtra_derivatives) then
     deallocate(fvars2d,fvars3d)
     call gsi_bundledestroy(yderivative,ier)
     call gsi_bundledestroy(xderivative,ier)
  endif
! end of threading loop
  return
end subroutine calctends_tl


*DECK DPLPMU
      SUBROUTINE DPLPMU (MRELAS, NVARS, LMX, LBM, NREDC, INFO, IENTER,
     +   ILEAVE, IOPT, NPP, JSTRT, IBASIS, IMAT, IBRC, IPR, IWR, IND,
     +   IBB, ANORM, EPS, UU, GG, RPRNRM, ERDNRM, DULNRM, THETA, COSTSC,
     +   XLAMDA, RHSNRM, AMAT, BASMAT, CSC, WR, RPRIM, WW, BU, BL, RHS,
     +   ERD, ERP, RZ, RG, COLNRM, COSTS, PRIMAL, DUALS, SINGLR, REDBAS,
     +   ZEROLV, STPEDG)
C***BEGIN PROLOGUE  DPLPMU
C***SUBSIDIARY
C***PURPOSE  Subsidiary to DSPLP
C***LIBRARY   SLATEC
C***TYPE      DOUBLE PRECISION (SPLPMU-S, DPLPMU-D)
C***AUTHOR  (UNKNOWN)
C***DESCRIPTION
C
C     THE EDITING REQUIRED TO CONVERT THIS SUBROUTINE FROM SINGLE TO
C     DOUBLE PRECISION INVOLVES THE FOLLOWING CHARACTER STRING CHANGES.
C
C     USE AN EDITING COMMAND (CHANGE) /STRING-1/(TO)STRING-2/.
C     /REAL (12 BLANKS)/DOUBLE PRECISION/,
C     /SASUM/DASUM/,/SCOPY/DCOPY/,/SDOT/DDOT/,
C     /.E0/.D0/
C
C     THIS SUBPROGRAM IS FROM THE DSPLP( ) PACKAGE.  IT PERFORMS THE
C     TASKS OF UPDATING THE PRIMAL SOLUTION, EDGE WEIGHTS, REDUCED
C     COSTS, AND MATRIX DECOMPOSITION.
C     IT IS THE MAIN PART OF THE PROCEDURE (MAKE MOVE AND UPDATE).
C
C     REVISED 821122-1100
C     REVISED YYMMDD
C
C***SEE ALSO  DSPLP
C***ROUTINES CALLED  DASUM, DCOPY, DDOT, DPLPDM, DPNNZR, DPRWPG, IDLOC,
C                    LA05BD, LA05CD, XERMSG
C***REVISION HISTORY  (YYMMDD)
C   811215  DATE WRITTEN
C   890531  Changed all specific intrinsics to generic.  (WRB)
C   890605  Removed unreferenced labels.  (WRB)
C   890606  Changed references from IPLOC to IDLOC.  (WRB)
C   890606  Removed unused COMMON block LA05DD.  (WRB)
C   891214  Prologue converted to Version 4.0 format.  (BAB)
C   900315  CALLs to XERROR changed to CALLs to XERMSG.  (THJ)
C   900328  Added TYPE section.  (WRB)
C***END PROLOGUE  DPLPMU
      INTEGER IBASIS(*),IMAT(*),IBRC(LBM,2),IPR(*),IWR(*),IND(*),IBB(*)
      DOUBLE PRECISION AIJ,ALPHA,ANORM,COSTSC,ERDNRM,DULNRM,EPS,GAMMA,
     * GG,GQ,ONE,RPRNRM,RZJ,SCALR,THETA,TWO,UU,WP,XLAMDA,RHSNRM,
     * ZERO,AMAT(*),BASMAT(*),CSC(*),WR(*),RPRIM(*),WW(*),BU(*),BL(*),
     * RHS(*),ERD(*),ERP(*),RZ(*),RG(*),COSTS(*),PRIMAL(*),DUALS(*),
     * COLNRM(*),RCOST,DASUM,DDOT,CNORM
      LOGICAL SINGLR,REDBAS,PAGEPL,TRANS,ZEROLV,STPEDG
C
C***FIRST EXECUTABLE STATEMENT  DPLPMU
      ZERO=0.D0
      ONE=1.D0
      TWO=2.D0
      LPG=LMX-(NVARS+4)
C
C     UPDATE THE PRIMAL SOLUTION WITH A MULTIPLE OF THE SEARCH
C     DIRECTION.
      I=1
      N20002=MRELAS
      GO TO 20003
20002 I=I+1
20003 IF ((N20002-I).LT.0) GO TO 20004
      RPRIM(I)=RPRIM(I)-THETA*WW(I)
      GO TO 20002
C
C     IF EJECTED VARIABLE IS LEAVING AT AN UPPER BOUND,  THEN
C     TRANSLATE RIGHT HAND SIDE.
20004 IF (.NOT.(ILEAVE.LT.0)) GO TO 20006
      IBAS=IBASIS(ABS(ILEAVE))
      SCALR=RPRIM(ABS(ILEAVE))
      ASSIGN 20009 TO NPR001
      GO TO 30001
20009 IBB(IBAS)=ABS(IBB(IBAS))+1
C
C     IF ENTERING VARIABLE IS RESTRICTED TO ITS UPPER BOUND, TRANSLATE
C     RIGHT HAND SIDE.  IF THE VARIABLE DECREASED FROM ITS UPPER
C     BOUND, A SIGN CHANGE IS REQUIRED IN THE TRANSLATION.
20006 IF (.NOT.(IENTER.EQ.ILEAVE)) GO TO 20010
      IBAS=IBASIS(IENTER)
      SCALR=THETA
      IF (MOD(IBB(IBAS),2).EQ.0) SCALR=-SCALR
      ASSIGN 20013 TO NPR001
      GO TO 30001
20013 IBB(IBAS)=IBB(IBAS)+1
      GO TO 20011
20010 IBAS=IBASIS(IENTER)
C
C     IF ENTERING VARIABLE IS DECREASING FROM ITS UPPER BOUND,
C     COMPLEMENT ITS PRIMAL VALUE.
      IF (.NOT.(IND(IBAS).EQ.3.AND.MOD(IBB(IBAS),2).EQ.0)) GO TO 20014
      SCALR=-(BU(IBAS)-BL(IBAS))
      IF (IBAS.LE.NVARS) SCALR=SCALR/CSC(IBAS)
      ASSIGN 20017 TO NPR001
      GO TO 30001
20017 THETA=-SCALR-THETA
      IBB(IBAS)=IBB(IBAS)+1
20014 CONTINUE
      RPRIM(ABS(ILEAVE))=THETA
      IBB(IBAS)=-ABS(IBB(IBAS))
      I=IBASIS(ABS(ILEAVE))
      IBB(I)=ABS(IBB(I))
      IF(PRIMAL(ABS(ILEAVE)+NVARS).GT.ZERO) IBB(I)=IBB(I)+1
C
C     INTERCHANGE COLUMN POINTERS TO NOTE EXCHANGE OF COLUMNS.
20011 IBAS=IBASIS(IENTER)
      IBASIS(IENTER)=IBASIS(ABS(ILEAVE))
      IBASIS(ABS(ILEAVE))=IBAS
C
C     IF VARIABLE WAS EXCHANGED AT A ZERO LEVEL, MARK IT SO THAT
C     IT CAN'T BE BROUGHT BACK IN.  THIS IS TO HELP PREVENT CYCLING.
      IF(ZEROLV) IBASIS(IENTER)=-ABS(IBASIS(IENTER))
      RPRNRM=MAX(RPRNRM,DASUM(MRELAS,RPRIM,1))
      K=1
      N20018=MRELAS
      GO TO 20019
20018 K=K+1
20019 IF ((N20018-K).LT.0) GO TO 20020
C
C     SEE IF VARIABLES THAT WERE CLASSIFIED AS INFEASIBLE HAVE NOW
C     BECOME FEASIBLE.  THIS MAY REQUIRED TRANSLATING UPPER BOUNDED
C     VARIABLES.
      IF (.NOT.(PRIMAL(K+NVARS).NE.ZERO .AND.
     *          ABS(RPRIM(K)).LE.RPRNRM*ERP(K))) GO TO 20022
      IF (.NOT.(PRIMAL(K+NVARS).GT.ZERO)) GO TO 20025
      IBAS=IBASIS(K)
      SCALR=-(BU(IBAS)-BL(IBAS))
      IF(IBAS.LE.NVARS)SCALR=SCALR/CSC(IBAS)
      ASSIGN 20028 TO NPR001
      GO TO 30001
20028 RPRIM(K)=-SCALR
      RPRNRM=RPRNRM-SCALR
20025 PRIMAL(K+NVARS)=ZERO
20022 CONTINUE
      GO TO 20018
C
C     UPDATE REDUCED COSTS, EDGE WEIGHTS, AND MATRIX DECOMPOSITION.
20020 IF (.NOT.(IENTER.NE.ILEAVE)) GO TO 20029
C
C     THE INCOMING VARIABLE IS ALWAYS CLASSIFIED AS FEASIBLE.
      PRIMAL(ABS(ILEAVE)+NVARS)=ZERO
C
      WP=WW(ABS(ILEAVE))
      GQ=DDOT(MRELAS,WW,1,WW,1)+ONE
C
C     COMPUTE INVERSE (TRANSPOSE) TIMES SEARCH DIRECTION.
      TRANS=.TRUE.
      CALL LA05BD(BASMAT,IBRC,LBM,MRELAS,IPR,IWR,WR,GG,WW,TRANS)
C
C     UPDATE THE MATRIX DECOMPOSITION.  COL. ABS(ILEAVE) IS LEAVING.
C     THE ARRAY DUALS(*) CONTAINS INTERMEDIATE RESULTS FOR THE
C     INCOMING COLUMN.
      CALL LA05CD(BASMAT,IBRC,LBM,MRELAS,IPR,IWR,DUALS,GG,UU,
     * ABS(ILEAVE))
      REDBAS=.FALSE.
      IF (.NOT.(GG.LT.ZERO)) GO TO 20032
C
C     REDECOMPOSE BASIS MATRIX WHEN AN ERROR RETURN FROM
C     LA05CD( ) IS NOTED.  THIS WILL PROBABLY BE DUE TO
C     SPACE BEING EXHAUSTED, GG=-7.
      CALL DPLPDM(
     *MRELAS,NVARS,LMX,LBM,NREDC,INFO,IOPT,
     *IBASIS,IMAT,IBRC,IPR,IWR,IND,IBB,
     *ANORM,EPS,UU,GG,
     *AMAT,BASMAT,CSC,WR,
     *SINGLR,REDBAS)
      IF (.NOT.(SINGLR)) GO TO 20035
      NERR=26
      CALL XERMSG ('SLATEC', 'DPLPMU',
     +   'IN DSPLP, MOVED TO A SINGULAR POINT. THIS SHOULD NOT HAPPEN.',
     +   NERR, IOPT)
      INFO=-NERR
      RETURN
20035 CONTINUE
      GO TO 30002
20038 CONTINUE
20032 CONTINUE
C
C     IF STEEPEST EDGE PRICING IS USED, UPDATE REDUCED COSTS
C     AND EDGE WEIGHTS.
      IF (.NOT.(STPEDG)) GO TO 20039
C
C     COMPUTE COL. ABS(ILEAVE) OF THE NEW INVERSE (TRANSPOSE) MATRIX
C     HERE ABS(ILEAVE) POINTS TO THE EJECTED COLUMN.
C     USE ERD(*) FOR TEMP. STORAGE.
      CALL DCOPY(MRELAS,ZERO,0,ERD,1)
      ERD(ABS(ILEAVE))=ONE
      TRANS=.TRUE.
      CALL LA05BD(BASMAT,IBRC,LBM,MRELAS,IPR,IWR,WR,GG,ERD,TRANS)
C
C     COMPUTE UPDATED DUAL VARIABLES IN DUALS(*).
      ASSIGN 20042 TO NPR003
      GO TO 30003
C
C     COMPUTE THE DOT PRODUCT OF COL. J OF THE NEW INVERSE (TRANSPOSE)
C     WITH EACH NON-BASIC COLUMN.  ALSO COMPUTE THE DOT PRODUCT OF THE
C     INVERSE (TRANSPOSE) OF NON-UPDATED MATRIX (TIMES) THE
C     SEARCH DIRECTION WITH EACH NON-BASIC COLUMN.
C     RECOMPUTE REDUCED COSTS.
20042 PAGEPL=.TRUE.
      CALL DCOPY(NVARS+MRELAS,ZERO,0,RZ,1)
      NNEGRC=0
      J=JSTRT
20043 IF (.NOT.(IBB(J).LE.0)) GO TO 20045
      PAGEPL=.TRUE.
      RG(J)=ONE
      GO TO 20046
C
C     NONBASIC INDEPENDENT VARIABLES (COLUMN IN SPARSE MATRIX STORAGE)
20045 IF (.NOT.(J.LE.NVARS)) GO TO 20048
      RZJ=COSTS(J)*COSTSC
      ALPHA=ZERO
      GAMMA=ZERO
C
C     COMPUTE THE DOT PRODUCT OF THE SPARSE MATRIX NONBASIC COLUMNS
C     WITH THREE VECTORS INVOLVED IN THE UPDATING STEP.
      IF (.NOT.(J.EQ.1)) GO TO 20051
      ILOW=NVARS+5
      GO TO 20052
20051 ILOW=IMAT(J+3)+1
20052 IF (.NOT.(PAGEPL)) GO TO 20054
      IL1=IDLOC(ILOW,AMAT,IMAT)
      IF (.NOT.(IL1.GE.LMX-1)) GO TO 20057
      ILOW=ILOW+2
      IL1=IDLOC(ILOW,AMAT,IMAT)
20057 CONTINUE
      IPAGE=ABS(IMAT(LMX-1))
      GO TO 20055
20054 IL1=IHI+1
20055 IHI=IMAT(J+4)-(ILOW-IL1)
20060 IU1=MIN(LMX-2,IHI)
      IF (.NOT.(IL1.GT.IU1)) GO TO 20062
      GO TO 20061
20062 CONTINUE
      DO 10 I=IL1,IU1
      RZJ=RZJ-AMAT(I)*DUALS(IMAT(I))
      ALPHA=ALPHA+AMAT(I)*ERD(IMAT(I))
      GAMMA=GAMMA+AMAT(I)*WW(IMAT(I))
10    CONTINUE
      IF (.NOT.(IHI.LE.LMX-2)) GO TO 20065
      GO TO 20061
20065 CONTINUE
      IPAGE=IPAGE+1
      KEY=1
      CALL DPRWPG(KEY,IPAGE,LPG,AMAT,IMAT)
      IL1=NVARS+5
      IHI=IHI-LPG
      GO TO 20060
20061 PAGEPL=IHI.EQ.(LMX-2)
      RZ(J)=RZJ*CSC(J)
      ALPHA=ALPHA*CSC(J)
      GAMMA=GAMMA*CSC(J)
      RG(J)=MAX(RG(J)-TWO*ALPHA*GAMMA+ALPHA**2*GQ,ONE+ALPHA**2)
C
C     NONBASIC DEPENDENT VARIABLES (COLUMNS DEFINED IMPLICITLY)
      GO TO 20049
20048 PAGEPL=.TRUE.
      SCALR=-ONE
      IF(IND(J).EQ.2) SCALR=ONE
      I=J-NVARS
      ALPHA=SCALR*ERD(I)
      RZ(J)=-SCALR*DUALS(I)
      GAMMA=SCALR*WW(I)
      RG(J)=MAX(RG(J)-TWO*ALPHA*GAMMA+ALPHA**2*GQ,ONE+ALPHA**2)
20049 CONTINUE
20046 CONTINUE
C
      RCOST=RZ(J)
      IF (MOD(IBB(J),2).EQ.0) RCOST=-RCOST
      IF (.NOT.(IND(J).EQ.3)) GO TO 20068
      IF(BU(J).EQ.BL(J)) RCOST=ZERO
20068 CONTINUE
      IF (IND(J).EQ.4) RCOST=-ABS(RCOST)
      CNORM=ONE
      IF (J.LE.NVARS) CNORM=COLNRM(J)
      IF (RCOST+ERDNRM*DULNRM*CNORM.LT.ZERO) NNEGRC=NNEGRC+1
      J=MOD(J,MRELAS+NVARS)+1
      IF (.NOT.(NNEGRC.GE.NPP .OR. J.EQ.JSTRT)) GO TO 20071
      GO TO 20044
20071 CONTINUE
      GO TO 20043
20044 JSTRT=J
C
C     UPDATE THE EDGE WEIGHT FOR THE EJECTED VARIABLE.
      RG(ABS(IBASIS(IENTER)))= GQ/WP**2
C
C     IF MINIMUM REDUCED COST (DANTZIG) PRICING IS USED,
C     CALCULATE THE NEW REDUCED COSTS.
      GO TO 20040
C
C     COMPUTE THE UPDATED DUALS IN DUALS(*).
20039 ASSIGN 20074 TO NPR003
      GO TO 30003
20074 CALL DCOPY(NVARS+MRELAS,ZERO,0,RZ,1)
      NNEGRC=0
      J=JSTRT
      PAGEPL=.TRUE.
C
20075 IF (.NOT.(IBB(J).LE.0)) GO TO 20077
      PAGEPL=.TRUE.
      GO TO 20078
C
C     NONBASIC INDEPENDENT VARIABLE (COLUMN IN SPARSE MATRIX STORAGE)
20077 IF (.NOT.(J.LE.NVARS)) GO TO 20080
      RZ(J)=COSTS(J)*COSTSC
      IF (.NOT.(J.EQ.1)) GO TO 20083
      ILOW=NVARS+5
      GO TO 20084
20083 ILOW=IMAT(J+3)+1
20084 CONTINUE
      IF (.NOT.(PAGEPL)) GO TO 20086
      IL1=IDLOC(ILOW,AMAT,IMAT)
      IF (.NOT.(IL1.GE.LMX-1)) GO TO 20089
      ILOW=ILOW+2
      IL1=IDLOC(ILOW,AMAT,IMAT)
20089 CONTINUE
      IPAGE=ABS(IMAT(LMX-1))
      GO TO 20087
20086 IL1=IHI+1
20087 CONTINUE
      IHI=IMAT(J+4)-(ILOW-IL1)
20092 IU1=MIN(LMX-2,IHI)
      IF (.NOT.(IU1.GE.IL1 .AND.MOD(IU1-IL1,2).EQ.0)) GO TO 20094
      RZ(J)=RZ(J)-AMAT(IL1)*DUALS(IMAT(IL1))
      IL1=IL1+1
20094 CONTINUE
      IF (.NOT.(IL1.GT.IU1)) GO TO 20097
      GO TO 20093
20097 CONTINUE
C
C     UNROLL THE DOT PRODUCT LOOP TO A DEPTH OF TWO.  (THIS IS DONE
C     FOR INCREASED EFFICIENCY).
      DO 40 I=IL1,IU1,2
      RZ(J)=RZ(J)-AMAT(I)*DUALS(IMAT(I))-AMAT(I+1)*DUALS(IMAT(I+1))
40    CONTINUE
      IF (.NOT.(IHI.LE.LMX-2)) GO TO 20100
      GO TO 20093
20100 CONTINUE
      IPAGE=IPAGE+1
      KEY=1
      CALL DPRWPG(KEY,IPAGE,LPG,AMAT,IMAT)
      IL1=NVARS+5
      IHI=IHI-LPG
      GO TO 20092
20093 PAGEPL=IHI.EQ.(LMX-2)
      RZ(J)=RZ(J)*CSC(J)
C
C     NONBASIC DEPENDENT VARIABLES (COLUMNS DEFINED IMPLICITLY)
      GO TO 20081
20080 PAGEPL=.TRUE.
      SCALR=-ONE
      IF(IND(J).EQ.2) SCALR=ONE
      I=J-NVARS
      RZ(J)=-SCALR*DUALS(I)
20081 CONTINUE
20078 CONTINUE
C
      RCOST=RZ(J)
      IF (MOD(IBB(J),2).EQ.0) RCOST=-RCOST
      IF (.NOT.(IND(J).EQ.3)) GO TO 20103
      IF(BU(J).EQ.BL(J)) RCOST=ZERO
20103 CONTINUE
      IF (IND(J).EQ.4) RCOST=-ABS(RCOST)
      CNORM=ONE
      IF (J.LE.NVARS) CNORM=COLNRM(J)
      IF (RCOST+ERDNRM*DULNRM*CNORM.LT.ZERO) NNEGRC=NNEGRC+1
      J=MOD(J,MRELAS+NVARS)+1
      IF (.NOT.(NNEGRC.GE.NPP .OR. J.EQ.JSTRT)) GO TO 20106
      GO TO 20076
20106 CONTINUE
      GO TO 20075
20076 JSTRT=J
20040 CONTINUE
      GO TO 20030
C
C     THIS IS NECESSARY ONLY FOR PRINTING OF INTERMEDIATE RESULTS.
20029 ASSIGN 20109 TO NPR003
      GO TO 30003
20109 CONTINUE
20030 RETURN
C     PROCEDURE (TRANSLATE RIGHT HAND SIDE)
C
C     PERFORM THE TRANSLATION ON THE RIGHT-HAND SIDE.
30001 IF (.NOT.(IBAS.LE.NVARS)) GO TO 20110
      I=0
20113 CALL DPNNZR(I,AIJ,IPLACE,AMAT,IMAT,IBAS)
      IF (.NOT.(I.LE.0)) GO TO 20115
      GO TO 20114
20115 CONTINUE
      RHS(I)=RHS(I)-SCALR*AIJ*CSC(IBAS)
      GO TO 20113
20114 GO TO 20111
20110 I=IBAS-NVARS
      IF (.NOT.(IND(IBAS).EQ.2)) GO TO 20118
      RHS(I)=RHS(I)-SCALR
      GO TO 20119
20118 RHS(I)=RHS(I)+SCALR
20119 CONTINUE
20111 CONTINUE
      RHSNRM=MAX(RHSNRM,DASUM(MRELAS,RHS,1))
      GO TO NPR001, (20009,20013,20017,20028)
C     PROCEDURE (COMPUTE NEW PRIMAL)
C
C     COPY RHS INTO WW(*), SOLVE SYSTEM.
30002 CALL DCOPY(MRELAS,RHS,1,WW,1)
      TRANS = .FALSE.
      CALL LA05BD(BASMAT,IBRC,LBM,MRELAS,IPR,IWR,WR,GG,WW,TRANS)
      CALL DCOPY(MRELAS,WW,1,RPRIM,1)
      RPRNRM=DASUM(MRELAS,RPRIM,1)
      GO TO 20038
C     PROCEDURE (COMPUTE NEW DUALS)
C
C     SOLVE FOR DUAL VARIABLES. FIRST COPY COSTS INTO DUALS(*).
30003 I=1
      N20121=MRELAS
      GO TO 20122
20121 I=I+1
20122 IF ((N20121-I).LT.0) GO TO 20123
      J=IBASIS(I)
      IF (.NOT.(J.LE.NVARS)) GO TO 20125
      DUALS(I)=COSTSC*COSTS(J)*CSC(J) + XLAMDA*PRIMAL(I+NVARS)
      GO TO 20126
20125 DUALS(I)=XLAMDA*PRIMAL(I+NVARS)
20126 CONTINUE
      GO TO 20121
C
20123 TRANS=.TRUE.
      CALL LA05BD(BASMAT,IBRC,LBM,MRELAS,IPR,IWR,WR,GG,DUALS,TRANS)
      DULNRM=DASUM(MRELAS,DUALS,1)
      GO TO NPR003, (20042,20074,20109)
      END