c Add a call to INT to resolve a warning issued by the g95 Fortran compiler. c SJP 2009/04/15 c c Minor fixes to resolve warnings issued by the g95 Fortran compiler. c SJP 2009/04/14 c c Parallel compiler directives replaced with equivalent OpenMP instructions. c SJP 2001/12/13 c c $Log: table.f,v $ c Revision 1.9 1997/12/17 23:22:44 ldr c Changes from MRD for parallel execution on NEC. c c Revision 1.8 1995/07/03 05:48:41 ldr c Mickles' changes to V4-5-30l for Cray multiprocessing, tidied by LDR. c c Revision 1.7 94/05/27 16:35:35 ldr c Make some variables double precision for Seca to avoid underflows. c c Revision 1.6 93/12/17 15:34:06 ldr c Hack V4-4-52l to change all continuation chars to & c c Revision 1.5 93/07/20 10:08:38 ldr c Use block data for initializing data in common, to keep the VP happy. c c Revision 1.4 92/12/09 14:44:41 ldr c Replaced all n's with nl's for compatibility with ogcm. c c Revision 1.3 92/05/11 15:14:01 ldr c Put Include PARAMS.f in source file rather than in RDPARM.f, c to avoid nested includes. c c Revision 1.2 92/04/15 12:36:46 mrd c Restructured radiation code include files and data input c c Revision 1.1 91/02/22 16:38:16 ldr c Initial release V3-0 c block data tab_blk include 'PARAMS.f' include 'RDPARM.f' include 'RNDDTA.f' c*** note: the data,equivalence and dimension statements for quantities c equivalenced to common block bandta depend on the value of the c parameter nblw. c dimension arndm1(64),arndm2(64),arndm3(35) dimension brndm1(64),brndm2(64),brndm3(35) dimension ap1(64),ap2(64),ap3(35) dimension bp1(64),bp2(64),bp3(35) dimension atp1(64),atp2(64),atp3(35) dimension btp1(64),btp2(64),btp3(35) dimension betad1(64),betad2(64),betad3(35) dimension bandl1(64),bandl2(64),bandl3(35) dimension bandh1(64),bandh2(64),bandh3(35) equivalence (arndm1(1),arndm(1)),(arndm2(1),arndm(65)), & (arndm3(1),arndm(129)) equivalence (brndm1(1),brndm(1)),(brndm2(1),brndm(65)), & (brndm3(1),brndm(129)) equivalence (ap1(1),ap(1)),(ap2(1),ap(65)), & (ap3(1),ap(129)) equivalence (bp1(1),bp(1)),(bp2(1),bp(65)), & (bp3(1),bp(129)) equivalence (atp1(1),atp(1)),(atp2(1),atp(65)), & (atp3(1),atp(129)) equivalence (btp1(1),btp(1)),(btp2(1),btp(65)), & (btp3(1),btp(129)) equivalence (betad1(1),betad(1)),(betad2(1),betad(65)), & (betad3(1),betad(129)) equivalence (bandl1(1),bandlo(1)),(bandl2(1),bandlo(65)), & (bandl3(1),bandlo(129)) equivalence (bandh1(1),bandhi(1)),(bandh2(1),bandhi(65)), & (bandh3(1),bandhi(129)) c c***the following data statements are band parameters obtained using c the 1982 afgl catalog on the specified bands data arndm1 / & 0.354693e+00, 0.269857e+03, 0.167062e+03, 0.201314e+04, & 0.964533e+03, 0.547971e+04, 0.152933e+04, 0.599429e+04, & 0.699329e+04, 0.856721e+04, 0.962489e+04, 0.233348e+04, & 0.127091e+05, 0.104383e+05, 0.504249e+04, 0.181227e+05, & 0.856480e+03, 0.136354e+05, 0.288635e+04, 0.170200e+04, & 0.209761e+05, 0.126797e+04, 0.110096e+05, 0.336436e+03, & 0.491663e+04, 0.863701e+04, 0.540389e+03, 0.439786e+04, & 0.347836e+04, 0.130557e+03, 0.465332e+04, 0.253086e+03, & 0.257387e+04, 0.488041e+03, 0.892991e+03, 0.117148e+04, & 0.125880e+03, 0.458852e+03, 0.142975e+03, 0.446355e+03, & 0.302887e+02, 0.394451e+03, 0.438112e+02, 0.348811e+02, & 0.615503e+02, 0.143165e+03, 0.103958e+02, 0.725108e+02, & 0.316628e+02, 0.946456e+01, 0.542675e+02, 0.351557e+02, & 0.301797e+02, 0.381010e+01, 0.126319e+02, 0.548010e+01, & 0.600199e+01, 0.640803e+00, 0.501549e-01, 0.167961e-01, & 0.178110e-01, 0.170166e+00, 0.273514e-01, 0.983767e+00/ data arndm2 / & 0.753946e+00, 0.941763e-01, 0.970547e+00, 0.268862e+00, & 0.564373e+01, 0.389794e+01, 0.310955e+01, 0.128235e+01, & 0.196414e+01, 0.247113e+02, 0.593435e+01, 0.377552e+02, & 0.305173e+02, 0.852479e+01, 0.116780e+03, 0.101490e+03, & 0.138939e+03, 0.324228e+03, 0.683729e+02, 0.471304e+03, & 0.159684e+03, 0.427101e+03, 0.114716e+03, 0.106190e+04, & 0.294607e+03, 0.762948e+03, 0.333199e+03, 0.830645e+03, & 0.162512e+04, 0.525676e+03, 0.137739e+04, 0.136252e+04, & 0.147164e+04, 0.187196e+04, 0.131118e+04, 0.103975e+04, & 0.621637e+01, 0.399459e+02, 0.950648e+02, 0.943161e+03, & 0.526821e+03, 0.104150e+04, 0.905610e+03, 0.228142e+04, & 0.806270e+03, 0.691845e+03, 0.155237e+04, 0.192241e+04, & 0.991871e+03, 0.123907e+04, 0.457289e+02, 0.146146e+04, & 0.319382e+03, 0.436074e+03, 0.374214e+03, 0.778217e+03, & 0.140227e+03, 0.562540e+03, 0.682685e+02, 0.820292e+02, & 0.178779e+03, 0.186150e+03, 0.383864e+03, 0.567416e+01/ data arndm3 / & 0.225129e+03, 0.473099e+01, 0.753149e+02, 0.233689e+02, & 0.339802e+02, 0.108855e+03, 0.380016e+02, 0.151039e+01, & 0.660346e+02, 0.370165e+01, 0.234169e+02, 0.440206e+00, & 0.615283e+01, 0.304077e+02, 0.117769e+01, 0.125248e+02, & 0.142652e+01, 0.241831e+00, 0.483721e+01, 0.226357e-01, & 0.549835e+01, 0.597067e+00, 0.404553e+00, 0.143584e+01, & 0.294291e+00, 0.466273e+00, 0.156048e+00, 0.656185e+00, & 0.172727e+00, 0.118349e+00, 0.141598e+00, 0.588581e-01, & 0.919409e-01, 0.155521e-01, 0.537083e-02/ data brndm1 / & 0.789571e-01, 0.920256e-01, 0.696960e-01, 0.245544e+00, & 0.188503e+00, 0.266127e+00, 0.271371e+00, 0.330917e+00, & 0.190424e+00, 0.224498e+00, 0.282517e+00, 0.130675e+00, & 0.212579e+00, 0.227298e+00, 0.138585e+00, 0.187106e+00, & 0.194527e+00, 0.177034e+00, 0.115902e+00, 0.118499e+00, & 0.142848e+00, 0.216869e+00, 0.149848e+00, 0.971585e-01, & 0.151532e+00, 0.865628e-01, 0.764246e-01, 0.100035e+00, & 0.171133e+00, 0.134737e+00, 0.105173e+00, 0.860832e-01, & 0.148921e+00, 0.869234e-01, 0.106018e+00, 0.184865e+00, & 0.767454e-01, 0.108981e+00, 0.123094e+00, 0.177287e+00, & 0.848146e-01, 0.119356e+00, 0.133829e+00, 0.954505e-01, & 0.155405e+00, 0.164167e+00, 0.161390e+00, 0.113287e+00, & 0.714720e-01, 0.741598e-01, 0.719590e-01, 0.140616e+00, & 0.355356e-01, 0.832779e-01, 0.128680e+00, 0.983013e-01, & 0.629660e-01, 0.643346e-01, 0.717082e-01, 0.629730e-01, & 0.875182e-01, 0.857907e-01, 0.358808e+00, 0.178840e+00/ data brndm2 / & 0.254265e+00, 0.297901e+00, 0.153916e+00, 0.537774e+00, & 0.267906e+00, 0.104254e+00, 0.400723e+00, 0.389670e+00, & 0.263701e+00, 0.338116e+00, 0.351528e+00, 0.267764e+00, & 0.186419e+00, 0.238237e+00, 0.210408e+00, 0.176869e+00, & 0.114715e+00, 0.173299e+00, 0.967770e-01, 0.172565e+00, & 0.162085e+00, 0.157782e+00, 0.886832e-01, 0.242999e+00, & 0.760298e-01, 0.164248e+00, 0.221428e+00, 0.166799e+00, & 0.312514e+00, 0.380600e+00, 0.353828e+00, 0.269500e+00, & 0.254759e+00, 0.285408e+00, 0.159764e+00, 0.721058e-01, & 0.170528e+00, 0.231595e+00, 0.307184e+00, 0.564136e-01, & 0.159884e+00, 0.147907e+00, 0.185666e+00, 0.183567e+00, & 0.182482e+00, 0.230650e+00, 0.175348e+00, 0.195978e+00, & 0.255323e+00, 0.198517e+00, 0.195500e+00, 0.208356e+00, & 0.309603e+00, 0.112011e+00, 0.102570e+00, 0.128276e+00, & 0.168100e+00, 0.177836e+00, 0.105533e+00, 0.903330e-01, & 0.126036e+00, 0.101430e+00, 0.124546e+00, 0.221406e+00/ data brndm3 / & 0.137509e+00, 0.911365e-01, 0.724508e-01, 0.795788e-01, & 0.137411e+00, 0.549175e-01, 0.787714e-01, 0.165544e+00, & 0.136484e+00, 0.146729e+00, 0.820496e-01, 0.846211e-01, & 0.785821e-01, 0.122527e+00, 0.125359e+00, 0.101589e+00, & 0.155756e+00, 0.189239e+00, 0.999086e-01, 0.480993e+00, & 0.100233e+00, 0.153754e+00, 0.130780e+00, 0.136136e+00, & 0.159353e+00, 0.156634e+00, 0.272265e+00, 0.186874e+00, & 0.192090e+00, 0.135397e+00, 0.131497e+00, 0.127463e+00, & 0.227233e+00, 0.190562e+00, 0.214005e+00/ data ap1 / & -0.675950e-02, -0.909459e-02, -0.800214e-02, -0.658673e-02, & -0.245580e-02, -0.710464e-02, -0.205565e-02, -0.446529e-02, & -0.440265e-02, -0.593625e-02, -0.201913e-02, -0.349169e-02, & -0.209324e-02, -0.127980e-02, -0.388007e-02, -0.140542e-02, & 0.518346e-02, -0.159375e-02, 0.250508e-02, 0.132182e-01, & -0.903779e-03, 0.110959e-01, 0.924528e-03, 0.207428e-01, & 0.364166e-02, 0.365229e-02, 0.884367e-02, 0.617260e-02, & 0.701340e-02, 0.184265e-01, 0.992822e-02, 0.908582e-02, & 0.106581e-01, 0.276268e-02, 0.158414e-01, 0.145747e-01, & 0.453080e-02, 0.214767e-01, 0.553895e-02, 0.195031e-01, & 0.237016e-01, 0.112371e-01, 0.275977e-01, 0.188833e-01, & 0.131079e-01, 0.130019e-01, 0.385122e-01, 0.111768e-01, & 0.622620e-02, 0.194397e-01, 0.134360e-01, 0.207829e-01, & 0.147960e-01, 0.744479e-02, 0.107564e-01, 0.181562e-01, & 0.170062e-01, 0.233303e-01, 0.256735e-01, 0.274745e-01, & 0.279259e-01, 0.197002e-01, 0.140268e-01, 0.185933e-01/ data ap2 / & 0.169525e-01, 0.214410e-01, 0.136577e-01, 0.169510e-01, & 0.173025e-01, 0.958346e-02, 0.255024e-01, 0.308943e-01, & 0.196031e-01, 0.183608e-01, 0.149419e-01, 0.206358e-01, & 0.140654e-01, 0.172797e-01, 0.145470e-01, 0.982987e-02, & 0.116695e-01, 0.811333e-02, 0.965823e-02, 0.649977e-02, & 0.462192e-02, 0.545929e-02, 0.680407e-02, 0.291235e-02, & -0.974773e-03, 0.341591e-02, 0.376198e-02, 0.770610e-03, & -0.940864e-04, 0.514532e-02, 0.232371e-02, -0.177741e-02, & -0.374892e-03, -0.370485e-03, -0.221435e-02, -0.490000e-02, & 0.588664e-02, 0.931411e-03, -0.456043e-03, -0.545576e-02, & -0.421136e-02, -0.353742e-02, -0.174276e-02, -0.361246e-02, & -0.337822e-02, -0.867030e-03, -0.118001e-02, -0.222405e-02, & -0.725144e-03, 0.118483e-02, 0.995087e-02, 0.273812e-03, & 0.417298e-02, 0.764294e-02, 0.631568e-02, -0.213528e-02, & 0.746130e-02, 0.110337e-02, 0.153157e-01, 0.504532e-02, & 0.406047e-02, 0.192895e-02, 0.202058e-02, 0.126420e-01/ data ap3 / & 0.310028e-02, 0.214779e-01, 0.560165e-02, 0.661070e-02, & 0.694966e-02, 0.539194e-02, 0.103745e-01, 0.180150e-01, & 0.747133e-02, 0.114927e-01, 0.115213e-01, 0.160709e-02, & 0.154278e-01, 0.112067e-01, 0.148690e-01, 0.154442e-01, & 0.123977e-01, 0.237539e-01, 0.162820e-01, 0.269484e-01, & 0.178081e-01, 0.143221e-01, 0.262468e-01, 0.217065e-01, & 0.107083e-01, 0.281220e-01, 0.115565e-01, 0.231244e-01, & 0.225197e-01, 0.178624e-01, 0.327708e-01, 0.116657e-01, & 0.277452e-01, 0.301647e-01, 0.349782e-01/ data bp1 / & 0.717848e-05, 0.169280e-04, 0.126710e-04, 0.758397e-05, & -0.533900e-05, 0.143490e-04, -0.595854e-05, 0.296465e-05, & 0.323446e-05, 0.115359e-04, -0.692861e-05, 0.131477e-04, & -0.624945e-05, -0.756955e-06, 0.107458e-05, -0.159796e-05, & -0.290529e-04, -0.170918e-05, -0.193934e-04, -0.707209e-04, & -0.148154e-04, -0.383162e-04, -0.186050e-04, -0.951796e-04, & -0.210944e-04, -0.330590e-04, -0.373087e-04, -0.408972e-04, & -0.396759e-04, -0.827756e-04, -0.573773e-04, -0.325384e-04, & -0.449411e-04, -0.271450e-04, -0.752791e-04, -0.549699e-04, & -0.225655e-04, -0.102034e-03, -0.740322e-05, -0.668846e-04, & -0.106063e-03, -0.304840e-04, -0.796023e-04, 0.504880e-04, & 0.486384e-04, -0.531946e-04, -0.147771e-03, -0.406785e-04, & 0.615750e-05, -0.486264e-04, -0.419335e-04, -0.819467e-04, & -0.709498e-04, 0.326984e-05, -0.369743e-04, -0.526848e-04, & -0.550050e-04, -0.684057e-04, -0.447093e-04, -0.778390e-04, & -0.982953e-04, -0.772497e-04, -0.119430e-05, -0.655187e-04/ data bp2 / & -0.339078e-04, 0.716657e-04, -0.335893e-04, 0.220239e-04, & -0.491012e-04, -0.393325e-04, -0.626461e-04, -0.795479e-04, & -0.599181e-04, -0.578153e-04, -0.597559e-05, -0.866750e-04, & -0.486783e-04, -0.580912e-04, -0.647368e-04, -0.350643e-04, & -0.566635e-04, -0.385738e-04, -0.463782e-04, -0.321485e-04, & -0.177300e-04, -0.250201e-04, -0.365492e-04, -0.165218e-04, & -0.649177e-05, -0.218458e-04, -0.984604e-05, -0.120034e-04, & -0.110119e-06, -0.164405e-04, -0.141396e-04, 0.315347e-05, & -0.141544e-05, -0.297320e-05, -0.216248e-05, 0.839264e-05, & -0.178197e-04, -0.106225e-04, -0.468195e-05, 0.997043e-05, & 0.679709e-05, 0.324610e-05, -0.367325e-05, 0.671058e-05, & 0.509293e-05, -0.437392e-05, -0.787922e-06, -0.271503e-06, & -0.437940e-05, -0.128205e-04, -0.417830e-04, -0.561134e-05, & -0.209940e-04, -0.414366e-04, -0.289765e-04, 0.680406e-06, & -0.558644e-05, -0.530395e-05, -0.622242e-04, -0.159979e-05, & -0.140286e-04, -0.128463e-04, -0.929499e-05, -0.327886e-04/ data bp3 / & -0.189353e-04, -0.737589e-04, -0.323471e-04, -0.272502e-04, & -0.321731e-04, -0.326958e-04, -0.509157e-04, -0.681890e-04, & -0.362182e-04, -0.354405e-04, -0.578392e-04, 0.238627e-05, & -0.709028e-04, -0.518717e-04, -0.491859e-04, -0.718017e-04, & -0.418978e-05, -0.940819e-04, -0.630375e-04, -0.478469e-04, & -0.751896e-04, -0.267113e-04, -0.109019e-03, -0.890983e-04, & -0.177301e-04, -0.120216e-03, 0.220464e-04, -0.734277e-04, & -0.868068e-04, -0.652319e-04, -0.136982e-03, -0.279933e-06, & -0.791824e-04, -0.111781e-03, -0.748263e-04/ data atp1 / & -0.722782e-02, -0.901531e-02, -0.821263e-02, -0.808024e-02, & -0.320169e-02, -0.661305e-02, -0.287272e-02, -0.486143e-02, & -0.242857e-02, -0.530288e-02, -0.146813e-02, -0.566474e-03, & -0.102192e-02, 0.300643e-03, -0.331655e-02, 0.648220e-03, & 0.552446e-02, -0.933046e-03, 0.205703e-02, 0.130638e-01, & -0.229828e-02, 0.715648e-02, 0.444446e-03, 0.193500e-01, & 0.364119e-02, 0.252713e-02, 0.102420e-01, 0.494224e-02, & 0.584934e-02, 0.146255e-01, 0.921986e-02, 0.768012e-02, & 0.916105e-02, 0.276223e-02, 0.125245e-01, 0.131146e-01, & 0.793016e-02, 0.201536e-01, 0.658631e-02, 0.171711e-01, & 0.228470e-01, 0.131306e-01, 0.226658e-01, 0.176086e-01, & 0.149987e-01, 0.143060e-01, 0.313189e-01, 0.117070e-01, & 0.133522e-01, 0.244259e-01, 0.148393e-01, 0.223982e-01, & 0.151792e-01, 0.180474e-01, 0.106299e-01, 0.191016e-01, & 0.171776e-01, 0.229724e-01, 0.275530e-01, 0.302731e-01, & 0.281662e-01, 0.199525e-01, 0.192588e-01, 0.173220e-01/ data atp2 / & 0.195220e-01, 0.169371e-01, 0.193212e-01, 0.145558e-01, & 0.189654e-01, 0.122030e-01, 0.186206e-01, 0.228842e-01, & 0.139343e-01, 0.164006e-01, 0.137276e-01, 0.154005e-01, & 0.114575e-01, 0.129956e-01, 0.115305e-01, 0.929260e-02, & 0.106359e-01, 0.771623e-02, 0.106075e-01, 0.597630e-02, & 0.493960e-02, 0.532554e-02, 0.646175e-02, 0.302693e-02, & 0.150899e-02, 0.310333e-02, 0.533734e-02, 0.239094e-03, & 0.356782e-02, 0.707574e-02, 0.215758e-02, -0.527589e-03, & 0.643893e-03, -0.101916e-02, -0.383336e-02, -0.445966e-02, & 0.880190e-02, 0.245662e-02, -0.560923e-03, -0.582201e-02, & -0.323233e-02, -0.454197e-02, -0.240905e-02, -0.343160e-02, & -0.335156e-02, -0.623846e-03, 0.393633e-03, -0.271593e-02, & -0.675874e-03, 0.920642e-03, 0.102168e-01, -0.250663e-03, & 0.437126e-02, 0.767434e-02, 0.569931e-02, -0.929326e-03, & 0.659414e-02, 0.280687e-02, 0.127614e-01, 0.780789e-02, & 0.374807e-02, 0.274288e-02, 0.534940e-02, 0.104349e-01/ data atp3 / & 0.294379e-02, 0.177846e-01, 0.523249e-02, 0.125339e-01, & 0.548538e-02, 0.577403e-02, 0.101532e-01, 0.170375e-01, & 0.758396e-02, 0.113402e-01, 0.106960e-01, 0.107782e-01, & 0.136148e-01, 0.992064e-02, 0.167276e-01, 0.149603e-01, & 0.136259e-01, 0.234521e-01, 0.166806e-01, 0.298505e-01, & 0.167592e-01, 0.186679e-01, 0.233062e-01, 0.228467e-01, & 0.128947e-01, 0.293979e-01, 0.219815e-01, 0.220663e-01, & 0.272710e-01, 0.237139e-01, 0.331743e-01, 0.208799e-01, & 0.281472e-01, 0.318440e-01, 0.370962e-01/ data btp1 / & 0.149748e-04, 0.188007e-04, 0.196530e-04, 0.124747e-04, & -0.215751e-07, 0.128357e-04, -0.265798e-05, 0.606262e-05, & 0.287668e-05, 0.974612e-05, -0.833451e-05, 0.584410e-05, & -0.452879e-05, -0.782537e-05, 0.786165e-05, -0.768351e-05, & -0.196168e-04, 0.177297e-06, -0.129258e-04, -0.642798e-04, & -0.986297e-05, -0.257145e-04, -0.141996e-04, -0.865089e-04, & -0.141691e-04, -0.272578e-04, -0.295198e-04, -0.308878e-04, & -0.313193e-04, -0.669272e-04, -0.475777e-04, -0.221332e-04, & -0.419930e-04, -0.102519e-04, -0.590184e-04, -0.574771e-04, & -0.240809e-04, -0.913994e-04, -0.908886e-05, -0.721074e-04, & -0.902837e-04, -0.447582e-04, -0.664544e-04, -0.143150e-04, & -0.511866e-05, -0.559352e-04, -0.104734e-03, -0.305206e-04, & 0.103303e-04, -0.613019e-04, -0.320040e-04, -0.738909e-04, & -0.388263e-04, 0.306515e-04, -0.352214e-04, -0.253940e-04, & -0.521369e-04, -0.746260e-04, -0.744124e-04, -0.881905e-04, & -0.933645e-04, -0.664045e-04, -0.570712e-05, -0.566312e-04/ data btp2 / & -0.364967e-04, 0.393501e-06, -0.234050e-04, -0.141317e-04, & -0.525480e-04, -0.172241e-04, -0.410843e-04, -0.358348e-04, & -0.256168e-04, -0.509482e-04, -0.180570e-04, -0.555356e-04, & -0.271464e-04, -0.274040e-04, -0.480889e-04, -0.275751e-04, & -0.415681e-04, -0.383770e-04, -0.280139e-04, -0.287919e-04, & -0.125865e-04, -0.265467e-04, -0.172765e-04, -0.164611e-04, & 0.189183e-04, -0.171219e-04, -0.132766e-04, -0.344611e-05, & -0.442832e-05, -0.185779e-04, -0.139755e-04, 0.168083e-05, & -0.395287e-05, -0.297871e-05, 0.434383e-05, 0.131741e-04, & -0.192637e-04, -0.549551e-05, 0.122553e-05, 0.204627e-04, & 0.154027e-04, 0.953462e-05, 0.131125e-05, 0.732839e-05, & 0.755405e-05, -0.305552e-05, -0.434858e-05, 0.308409e-05, & -0.164787e-05, -0.818533e-05, -0.355041e-04, -0.504696e-05, & -0.229022e-04, -0.356891e-04, -0.230346e-04, 0.518835e-05, & -0.160187e-04, -0.104617e-04, -0.464754e-04, -0.115807e-04, & -0.130230e-04, -0.603491e-05, -0.125324e-04, -0.165516e-04/ data btp3 / & -0.991679e-05, -0.529432e-04, -0.200199e-04, -0.181977e-04, & -0.220940e-04, -0.204483e-04, -0.432584e-04, -0.449109e-04, & -0.247305e-04, -0.174253e-04, -0.484446e-04, 0.354150e-04, & -0.425581e-04, -0.406562e-04, -0.505495e-04, -0.651856e-04, & -0.153953e-04, -0.894294e-04, -0.616551e-04, -0.846504e-04, & -0.699414e-04, -0.376203e-04, -0.940985e-04, -0.753050e-04, & -0.183710e-04, -0.123907e-03, -0.279347e-04, -0.736381e-04, & -0.103588e-03, -0.754117e-04, -0.140991e-03, -0.366687e-04, & -0.927785e-04, -0.125321e-03, -0.115290e-03/ data betad1 / & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.234879e+03, 0.217419e+03, 0.201281e+03, 0.186364e+03, & 0.172576e+03, 0.159831e+03, 0.148051e+03, 0.137163e+03, & 0.127099e+03, 0.117796e+03, 0.109197e+03, 0.101249e+03, & 0.939031e+02, 0.871127e+02, 0.808363e+02, 0.750349e+02, & 0.497489e+02, 0.221212e+02, 0.113124e+02, 0.754174e+01, & 0.589554e+01, 0.495227e+01, 0.000000e+00, 0.000000e+00/ data betad2 / & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00/ data betad3 / & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.000000e+00, 0.000000e+00, 0.000000e+00/ data bandl1 / & 0.000000e+00, 0.100000e+02, 0.200000e+02, 0.300000e+02, & 0.400000e+02, 0.500000e+02, 0.600000e+02, 0.700000e+02, & 0.800000e+02, 0.900000e+02, 0.100000e+03, 0.110000e+03, & 0.120000e+03, 0.130000e+03, 0.140000e+03, 0.150000e+03, & 0.160000e+03, 0.170000e+03, 0.180000e+03, 0.190000e+03, & 0.200000e+03, 0.210000e+03, 0.220000e+03, 0.230000e+03, & 0.240000e+03, 0.250000e+03, 0.260000e+03, 0.270000e+03, & 0.280000e+03, 0.290000e+03, 0.300000e+03, 0.310000e+03, & 0.320000e+03, 0.330000e+03, 0.340000e+03, 0.350000e+03, & 0.360000e+03, 0.370000e+03, 0.380000e+03, 0.390000e+03, & 0.400000e+03, 0.410000e+03, 0.420000e+03, 0.430000e+03, & 0.440000e+03, 0.450000e+03, 0.460000e+03, 0.470000e+03, & 0.480000e+03, 0.490000e+03, 0.500000e+03, 0.510000e+03, & 0.520000e+03, 0.530000e+03, 0.540000e+03, 0.550000e+03, & 0.560000e+03, 0.670000e+03, 0.800000e+03, 0.900000e+03, & 0.990000e+03, 0.107000e+04, 0.120000e+04, 0.121000e+04/ data bandl2 / & 0.122000e+04, 0.123000e+04, 0.124000e+04, 0.125000e+04, & 0.126000e+04, 0.127000e+04, 0.128000e+04, 0.129000e+04, & 0.130000e+04, 0.131000e+04, 0.132000e+04, 0.133000e+04, & 0.134000e+04, 0.135000e+04, 0.136000e+04, 0.137000e+04, & 0.138000e+04, 0.139000e+04, 0.140000e+04, 0.141000e+04, & 0.142000e+04, 0.143000e+04, 0.144000e+04, 0.145000e+04, & 0.146000e+04, 0.147000e+04, 0.148000e+04, 0.149000e+04, & 0.150000e+04, 0.151000e+04, 0.152000e+04, 0.153000e+04, & 0.154000e+04, 0.155000e+04, 0.156000e+04, 0.157000e+04, & 0.158000e+04, 0.159000e+04, 0.160000e+04, 0.161000e+04, & 0.162000e+04, 0.163000e+04, 0.164000e+04, 0.165000e+04, & 0.166000e+04, 0.167000e+04, 0.168000e+04, 0.169000e+04, & 0.170000e+04, 0.171000e+04, 0.172000e+04, 0.173000e+04, & 0.174000e+04, 0.175000e+04, 0.176000e+04, 0.177000e+04, & 0.178000e+04, 0.179000e+04, 0.180000e+04, 0.181000e+04, & 0.182000e+04, 0.183000e+04, 0.184000e+04, 0.185000e+04/ data bandl3 / & 0.186000e+04, 0.187000e+04, 0.188000e+04, 0.189000e+04, & 0.190000e+04, 0.191000e+04, 0.192000e+04, 0.193000e+04, & 0.194000e+04, 0.195000e+04, 0.196000e+04, 0.197000e+04, & 0.198000e+04, 0.199000e+04, 0.200000e+04, 0.201000e+04, & 0.202000e+04, 0.203000e+04, 0.204000e+04, 0.205000e+04, & 0.206000e+04, 0.207000e+04, 0.208000e+04, 0.209000e+04, & 0.210000e+04, 0.211000e+04, 0.212000e+04, 0.213000e+04, & 0.214000e+04, 0.215000e+04, 0.216000e+04, 0.217000e+04, & 0.218000e+04, 0.219000e+04, 0.227000e+04/ data bandh1 / & 0.100000e+02, 0.200000e+02, 0.300000e+02, 0.400000e+02, & 0.500000e+02, 0.600000e+02, 0.700000e+02, 0.800000e+02, & 0.900000e+02, 0.100000e+03, 0.110000e+03, 0.120000e+03, & 0.130000e+03, 0.140000e+03, 0.150000e+03, 0.160000e+03, & 0.170000e+03, 0.180000e+03, 0.190000e+03, 0.200000e+03, & 0.210000e+03, 0.220000e+03, 0.230000e+03, 0.240000e+03, & 0.250000e+03, 0.260000e+03, 0.270000e+03, 0.280000e+03, & 0.290000e+03, 0.300000e+03, 0.310000e+03, 0.320000e+03, & 0.330000e+03, 0.340000e+03, 0.350000e+03, 0.360000e+03, & 0.370000e+03, 0.380000e+03, 0.390000e+03, 0.400000e+03, & 0.410000e+03, 0.420000e+03, 0.430000e+03, 0.440000e+03, & 0.450000e+03, 0.460000e+03, 0.470000e+03, 0.480000e+03, & 0.490000e+03, 0.500000e+03, 0.510000e+03, 0.520000e+03, & 0.530000e+03, 0.540000e+03, 0.550000e+03, 0.560000e+03, & 0.670000e+03, 0.800000e+03, 0.900000e+03, 0.990000e+03, & 0.107000e+04, 0.120000e+04, 0.121000e+04, 0.122000e+04/ data bandh2 / & 0.123000e+04, 0.124000e+04, 0.125000e+04, 0.126000e+04, & 0.127000e+04, 0.128000e+04, 0.129000e+04, 0.130000e+04, & 0.131000e+04, 0.132000e+04, 0.133000e+04, 0.134000e+04, & 0.135000e+04, 0.136000e+04, 0.137000e+04, 0.138000e+04, & 0.139000e+04, 0.140000e+04, 0.141000e+04, 0.142000e+04, & 0.143000e+04, 0.144000e+04, 0.145000e+04, 0.146000e+04, & 0.147000e+04, 0.148000e+04, 0.149000e+04, 0.150000e+04, & 0.151000e+04, 0.152000e+04, 0.153000e+04, 0.154000e+04, & 0.155000e+04, 0.156000e+04, 0.157000e+04, 0.158000e+04, & 0.159000e+04, 0.160000e+04, 0.161000e+04, 0.162000e+04, & 0.163000e+04, 0.164000e+04, 0.165000e+04, 0.166000e+04, & 0.167000e+04, 0.168000e+04, 0.169000e+04, 0.170000e+04, & 0.171000e+04, 0.172000e+04, 0.173000e+04, 0.174000e+04, & 0.175000e+04, 0.176000e+04, 0.177000e+04, 0.178000e+04, & 0.179000e+04, 0.180000e+04, 0.181000e+04, 0.182000e+04, & 0.183000e+04, 0.184000e+04, 0.185000e+04, 0.186000e+04/ data bandh3 / & 0.187000e+04, 0.188000e+04, 0.189000e+04, 0.190000e+04, & 0.191000e+04, 0.192000e+04, 0.193000e+04, 0.194000e+04, & 0.195000e+04, 0.196000e+04, 0.197000e+04, 0.198000e+04, & 0.199000e+04, 0.200000e+04, 0.201000e+04, 0.202000e+04, & 0.203000e+04, 0.204000e+04, 0.205000e+04, 0.206000e+04, & 0.207000e+04, 0.208000e+04, 0.209000e+04, 0.210000e+04, & 0.211000e+04, 0.212000e+04, 0.213000e+04, 0.214000e+04, & 0.215000e+04, 0.216000e+04, 0.217000e+04, 0.218000e+04, & 0.219000e+04, 0.220000e+04, 0.238000e+04/ data ao3rnd / & 0.543368e+02, 0.234676e+04, 0.384881e+02/ data bo3rnd / & 0.526064e+01, 0.922424e+01, 0.496515e+01/ data awide / & 0.309801e+01/ data bwide / & 0.495357e-01/ data apwd / & 0.177115e-01/ data bpwd / & -0.545226e-04/ data atpwd / & 0.187967e-01/ data btpwd / & -0.567449e-04/ data betawd / & 0.347839e+02/ data betinw / & 0.766811e+01/ data bdlowd / & 0.560000e+03/ data bdhiwd / & 0.800000e+03/ data acomb / & 0.152070e+05, 0.332194e+04, 0.527177e+03, 0.163124e+03, & 0.268808e+03, 0.534591e+02, 0.268071e+02, 0.123133e+02, & 0.600199e+01, 0.640803e+00, 0.501549e-01, 0.167961e-01, & 0.178110e-01, 0.170166e+00, 0.537083e-02/ data bcomb / & 0.152538e+00, 0.118677e+00, 0.103660e+00, 0.100119e+00, & 0.127518e+00, 0.118409e+00, 0.904061e-01, 0.642011e-01, & 0.629660e-01, 0.643346e-01, 0.717082e-01, 0.629730e-01, & 0.875182e-01, 0.857907e-01, 0.214005e+00/ data apcm / & -0.671879e-03, 0.654345e-02, 0.143657e-01, 0.923593e-02, & 0.117022e-01, 0.159596e-01, 0.181600e-01, 0.145013e-01, & 0.170062e-01, 0.233303e-01, 0.256735e-01, 0.274745e-01, & 0.279259e-01, 0.197002e-01, 0.349782e-01/ data bpcm / & -0.113520e-04, -0.323965e-04, -0.448417e-04, -0.230779e-04, & -0.361981e-04, -0.145117e-04, 0.198349e-04, -0.486529e-04, & -0.550050e-04, -0.684057e-04, -0.447093e-04, -0.778390e-04, & -0.982953e-04, -0.772497e-04, -0.748263e-04/ data atpcm / & -0.106346e-02, 0.641531e-02, 0.137362e-01, 0.922513e-02, & 0.136162e-01, 0.169791e-01, 0.206959e-01, 0.166223e-01, & 0.171776e-01, 0.229724e-01, 0.275530e-01, 0.302731e-01, & 0.281662e-01, 0.199525e-01, 0.370962e-01/ data btpcm / & -0.735731e-05, -0.294149e-04, -0.505592e-04, -0.280894e-04, & -0.492972e-04, -0.341508e-04, -0.362947e-04, -0.250487e-04, & -0.521369e-04, -0.746260e-04, -0.744124e-04, -0.881905e-04, & -0.933645e-04, -0.664045e-04, -0.115290e-03/ data betacm / & 0.000000e+00, 0.000000e+00, 0.000000e+00, 0.000000e+00, & 0.188625e+03, 0.144293e+03, 0.174098e+03, 0.909366e+02, & 0.497489e+02, 0.221212e+02, 0.113124e+02, 0.754174e+01, & 0.589554e+01, 0.495227e+01, 0.000000e+00/ data iband / & 2, 1, 2, 2, 1, 2, 1, 3, 2, 2, & 3, 2, 2, 4, 2, 4, 2, 3, 3, 2, & 4, 3, 4, 3, 7, 5, 6, 7, 6, 5, & 7, 6, 7, 8, 6, 6, 8, 8, 8, 8/ end c****************************************************************************** subroutine table !$OMP THREADPRIVATE ( /RADISW/ ) c subroutine table computes table entries used in the longwave radia c program. also calculated are indices used in strip-mining and for c some pre-computable functions. c inputs: c outputs: c em1,em1wde,table1,table2,table3 tabcom c em3,source,dsrce,ind,indx2,kmaxv tabcom c kmaxvm, tabcom c ao3rnd,bo3rnd,ab15 bandta c ab15wd,skc1r,sko3r,sko2d bdwide c include 'HCON.f' include 'PARAMS.f' include 'RDPARM.f' include 'RADISW.f' include 'RNDDTA.f' include 'TABCOM.f' c dimension sum(28,180),pertsm(28,180),sum3(28,180), & sumwde(28,180),srcwd(28,nblx),src1nb(28,nblw),dbdtnb(28,nblw) dimension zmass(181),zroot(181),sc(28),dsc(28),xtemv(28), & tfour(28),fortcu(28),x(28),x1(28),x2(180),srcs(28), & sum4(28),sum6(28),sum7(28),sum8(28),sum4wd(28), & r1(28),r2(28),s2(28),t3(28),r1wd(28) dimension expo(180),fac(180) dimension cnusb(30),dnusb(30) dimension alfanb(nblw),arotnb(nblw),delcm(nbly) dimension anb(nblw),bnb(nblw),centnb(nblw),delnb(nblw) double precision x2,expo data delcm / & 0.300000e+02, 0.110000e+03, 0.600000e+02, 0.400000e+02, & 0.200000e+02, 0.500000e+02, 0.400000e+02, 0.500000e+02, & 0.110000e+03, 0.130000e+03, 0.100000e+03, 0.900000e+02, & 0.800000e+02, 0.130000e+03, 0.110000e+03/ c*** note: the data,equivalence and dimension statements for quantities c equivalenced to common block bandta depend on the value of the c parameter nblw. c dimension arndm1(64),arndm2(64),arndm3(35) dimension brndm1(64),brndm2(64),brndm3(35) dimension ap1(64),ap2(64),ap3(35) dimension bp1(64),bp2(64),bp3(35) dimension atp1(64),atp2(64),atp3(35) dimension btp1(64),btp2(64),btp3(35) dimension betad1(64),betad2(64),betad3(35) dimension bandl1(64),bandl2(64),bandl3(35) dimension bandh1(64),bandh2(64),bandh3(35) equivalence (arndm1(1),arndm(1)),(arndm2(1),arndm(65)), & (arndm3(1),arndm(129)) equivalence (brndm1(1),brndm(1)),(brndm2(1),brndm(65)), & (brndm3(1),brndm(129)) equivalence (ap1(1),ap(1)),(ap2(1),ap(65)), & (ap3(1),ap(129)) equivalence (bp1(1),bp(1)),(bp2(1),bp(65)), & (bp3(1),bp(129)) equivalence (atp1(1),atp(1)),(atp2(1),atp(65)), & (atp3(1),atp(129)) equivalence (btp1(1),btp(1)),(btp2(1),btp(65)), & (btp3(1),btp(129)) equivalence (betad1(1),betad(1)),(betad2(1),betad(65)), & (betad3(1),betad(129)) equivalence (bandl1(1),bandlo(1)),(bandl2(1),bandlo(65)), & (bandl3(1),bandlo(129)) equivalence (bandh1(1),bandhi(1)),(bandh2(1),bandhi(65)), & (bandh3(1),bandhi(129)) c***compute local quantities and ao3,bo3,ab15 c....for narrow-bands... do 101 nx=1,nblw anb(nx)=arndm(nx) bnb(nx)=brndm(nx) centnb(nx)=haf*(bandlo(nx)+bandhi(nx)) delnb(nx)=bandhi(nx)-bandlo(nx) 101 continue ab15(1)=anb(57)*bnb(57) ab15(2)=anb(58)*bnb(58) c....for wide bands... ab15wd=awide*bwide c c***compute indices: ind,indx2,kmaxv do 111 i=1,imax ind(i)=i 111 continue icnt=0 do 113 i1=1,l i2e=lp1-i1 do 115 i2=1,i2e icnt=icnt+1 indx2(icnt)=lp1*(i2-1)+lp2*i1 115 continue 113 continue kmaxv(1)=1 do 117 i=2,l kmaxv(i)=kmaxv(i-1)+(lp2-i) 117 continue kmaxvm=kmaxv(l) c***compute ratios of cont. coeffs skc1r=betawd/betinw sko3r=betad(61)/betinw sko2d=one/betinw c c****begin table computations here*** c***compute temps, masses for table entries c---note: the dimensioning and initialization of xtemv and other arrays c with dimension of 28 imply a restriction of model temperatures from c 100k to 370k. c---the dimensioning of zmass,zroot and other arrays with dimension of c 180 imply a restriction of model h2o amounts such that optical paths c are between 10**-16 and 10**2, in cgs units. zmass(1)=h1m16 do 201 j=1,180 jp=j+1 zroot(j)=sqrt(zmass(j)) zmass(jp)=zmass(j)*h1p25892 201 continue do 203 i=1,28 xtemv(i)=hninety+ten*i tfour(i)=xtemv(i)*xtemv(i)*xtemv(i)*xtemv(i) fortcu(i)=four*xtemv(i)*xtemv(i)*xtemv(i) 203 continue c******the computation of source,dsrce is needed only c for the combined wide-band case.to obtain them,the source c must be computed for each of the (nblx) wide bands(=srcwd) c then combined (using iband) into source. do 205 nx=1,nbly do 205 i=1,28 source(i,nx)=zero 205 continue do 207 nx=1,nblx do 207 i=1,28 srcwd(i,nx)=zero 207 continue c---begin freq. loop (on nl) do 211 nx=1,nblx if (nx.le.46) then c***the 160-1200 band cases cent=centnb(nx+16) del=delnb(nx+16) bdlo=bandlo(nx+16) bdhi=bandhi(nx+16) endif if (nx.eq.nblx) then c***the 2270-2380 band case cent=centnb(nblw) del=delnb(nblw) bdlo=bandlo(nblw) bdhi=bandhi(nblw) endif c***for purposes of accuracy, all evaluations of planck fctns are made c on 10 cm-1 intervals, then summed into the (nblx) wide bands. nsubds=int((del-h1m3)/10+1) do 213 nsb=1,nsubds if (nsb.ne.nsubds) then cnusb(nsb)=ten*(nsb-1)+bdlo+five dnusb(nsb)=ten else cnusb(nsb)=haf*(ten*(nsb-1)+bdlo+bdhi) dnusb(nsb)=bdhi-(ten*(nsb-1)+bdlo) endif c1=(h37412m5)*cnusb(nsb)**3 c---begin temp. loop (on i) do 215 i=1,28 x(i)=h1p4387*cnusb(nsb)/xtemv(i) x1(i)=exp(x(i)) srcs(i)=c1/(x1(i)-one) srcwd(i,nx)=srcwd(i,nx)+srcs(i)*dnusb(nsb) 215 continue 213 continue 211 continue c***the following loops create the combined wide band quantities source c and dsrce do 221 nx=1,40 do 221 i=1,28 source(i,iband(nx))=source(i,iband(nx))+srcwd(i,nx) 221 continue do 223 nx=9,nbly do 223 i=1,28 source(i,nx)=srcwd(i,nx+32) 223 continue do 225 nx=1,nbly do 225 i=1,27 dsrce(i,nx)=(source(i+1,nx)-source(i,nx))*hp1 225 continue do 231 nx=1,nblw alfanb(nx)=bnb(nx)*anb(nx) arotnb(nx)=sqrt(alfanb(nx)) 231 continue c***first compute planck fctns (src1nb) and derivatives (dbdtnb) for c use in table evaluations. these are different from source,dsrce c because different frequency pts are used in evaluation, the freq. c ranges are different, and the derivative algorithm is different. c do 301 nx=1,nblw cent=centnb(nx) del=delnb(nx) c---note: at present, the ia loop is only used for ia=2. the loop struct c is kept so that in the future, we may use a quadrature scheme for c the planck fctn evaluation, rather than use the mid-band frequency. do 303 ia=1,3 anu=cent+haf*(ia-2)*del c1=(h37412m5)*anu*anu*anu+h1m20 c---temperature loop--- do 305 i=1,28 x(i)=h1p4387*anu/xtemv(i) x1(i)=exp(x(i)) sc(i)=c1/((x1(i)-one)+h1m20) dsc(i)=sc(i)*sc(i)*x(i)*x1(i)/(xtemv(i)*c1) 305 continue if (ia.eq.2) then do 307 i=1,28 src1nb(i,nx)=del*sc(i) dbdtnb(i,nx)=del*dsc(i) 307 continue endif 303 continue 301 continue c***next compute r1,r2,s2,and t3- coefficients used for e3 function c when the optical path is less than 10-4. in this case, we assume a c different dependence on (zmass). c---also obtain r1wd, which is r1 summed over the 160-560 cm-1 range do 311 i=1,28 sum4(i)=zero sum6(i)=zero sum7(i)=zero sum8(i)=zero sum4wd(i)=zero 311 continue do 313 nx=1,nblw cent=centnb(nx) c***perform summations for freq. ranges of 0-560,1200-2200 cm-1 for sum4 c sum6,sum7,sum8 if (cent.lt.560. .or. cent.gt.1200..and.cent.le.2200.) then do 315 i=1,28 sum4(i)=sum4(i)+src1nb(i,nx) sum6(i)=sum6(i)+dbdtnb(i,nx) sum7(i)=sum7(i)+dbdtnb(i,nx)*arotnb(nx) sum8(i)=sum8(i)+dbdtnb(i,nx)*alfanb(nx) 315 continue endif c***perform summations over 160-560 cm-1 freq range for e1 calcs (sum4wd if (cent.gt.160. .and. cent.lt.560.) then do 316 i=1,28 sum4wd(i)=sum4wd(i)+src1nb(i,nx) 316 continue endif 313 continue do 317 i=1,28 r1(i)=sum4(i)/tfour(i) r2(i)=sum6(i)/fortcu(i) s2(i)=sum7(i)/fortcu(i) t3(i)=sum8(i)/fortcu(i) r1wd(i)=sum4wd(i)/tfour(i) 317 continue do 401 j=1,180 do 401 i=1,28 sum(i,j)=zero pertsm(i,j)=zero sum3(i,j)=zero sumwde(i,j)=zero 401 continue c---frequency loop begins--- do 411 nx=1,nblw cent=centnb(nx) c***perform calculations for freq. ranges of 0-560,1200-2200 cm-1 if (cent.lt.560. .or. cent.gt.1200..and.cent.le.2200.) then do 413 j=1,180 x2(j)=arotnb(nx)*zroot(j) expo(j)=exp(-x2(j)) 413 continue do 415 j=1,180 if (x2(j).ge.hundred) then expo(j)=zero endif 415 continue do 417 j=121,180 fac(j)=zmass(j)*(one-(one+x2(j))*expo(j))/(x2(j)*x2(j)) 417 continue do 419 j=1,180 do 419 i=1,28 sum(i,j)=sum(i,j)+src1nb(i,nx)*expo(j) pertsm(i,j)=pertsm(i,j)+dbdtnb(i,nx)*expo(j) 419 continue do 421 j=121,180 do 421 i=1,28 sum3(i,j)=sum3(i,j)+dbdtnb(i,nx)*fac(j) 421 continue endif c---compute sum over 160-560 cm-1 range for use in e1 calcs (sumwde) if (cent.gt.160. .and. cent.lt.560.) then do 420 j=1,180 do 420 i=1,28 sumwde(i,j)=sumwde(i,j)+src1nb(i,nx)*expo(j) 420 continue endif 411 continue do 431 j=1,180 do 431 i=1,28 em1(i,j)=sum(i,j)/tfour(i) table1(i,j)=pertsm(i,j)/fortcu(i) 431 continue do 433 j=121,180 do 433 i=1,28 em3(i,j)=sum3(i,j)/fortcu(i) 433 continue do 441 j=1,179 do 441 i=1,28 table2(i,j)=(table1(i,j+1)-table1(i,j))*ten 441 continue do 443 j=1,180 do 443 i=1,27 table3(i,j)=(table1(i+1,j)-table1(i,j))*hp1 443 continue do 445 i=1,28 table2(i,180)=zero 445 continue do 447 j=1,180 table3(28,j)=zero 447 continue do 449 j=1,2 do 449 i=1,28 em1(i,j)=r1(i) 449 continue do 451 j=1,120 do 451 i=1,28 em3(i,j)=r2(i)/two-s2(i)*sqrt(zmass(j))/three+t3(i)*zmass(j)/eight 451 continue do 453 j=121,180 do 453 i=1,28 em3(i,j)=em3(i,j)/zmass(j) 453 continue c***now compute e1 tables for 160-560 cm-1 bands only. c we use r1wd and sumwde obtained above. do 501 j=1,180 do 501 i=1,28 em1wde(i,j)=sumwde(i,j)/tfour(i) 501 continue do 503 j=1,2 do 503 i=1,28 em1wde(i,j)=r1wd(i) 503 continue return end