        subroutine SOLAR
      include 'SIZE.INC'
      include 'GLOBAL.INC'
      include 'LOCAL.INC'
      include 'UNITS.INC'
      include 'LOCAL1.INC'
      include 'LOCAL2.INC'
        double precision DINTPT
        real YTEMP, GLOLIT, TIMER, TNIGHT, XINT(11), YINT(11), TEMP
        real CENLAM(46), S1, S2, YHI
        real ABFRAC(46), TAU2, TAU4, FA3, FA4, F1, F2, FB3, FB4
        real ELAM0(4), KAER(4), PAER(4), LAMA0(4), CAPEL(4)
        real LAMAR, ELAM0R
        real EXTAER(46)
        real K3(46), RAYFAC(46), NHI(3), RHUML
        real HIBEAM, EMM, SUNIN(46), XTES, EXPARG
        real ECCEN(13), LATL, DECLIN(13)
        integer I, I2, I3, II, J2, N2, NFIRST, NLAST, ELEVEN
        integer NBLOC, III, IV, VRAIL
        character AIRVEC(4)*1, CCHAR(2)*1
        character KOUT*2, NMON*4, TAG*1
        logical print, MEAN
      include 'SOLAR.INC'
        data CENLAM/280.,282.5,285.,287.5,290.,292.5,295.,297.5,300.,
     &  302.5,305.,307.5,310.,312.5,315.,317.5,320.,323.1,330.,340.,
     &  350.,360.,370.,380.,390.,400.,410.,420.,430.,440.,450.,460.,
     &  470.,480.,490.,503.75,525.,550.,575.,600.,625.,650.,675.,
     &  706.25,750.,800./
      data ELEVEN/11/
        data ABFRAC/.152, .151, .150, .149, .148, .147, .147, .146,
     &  .145, .144, .143, .142, .141, .140, .140, .139, .138, .137,
     &  .134, .131, .128, .125, .122, .119, .116, .114, .111, .108,
     &  .106, .103, .101, .0982, .0959, .0936, .0913, .0883, .0839,
     &  .0789, .0743, .0699, .0658, .0619, .0583, .0540, .0486, .0430/
        data ELAM0/ 0.255, 0.288,  0.106, 0.081/
        data KAER / 1.962, 2.758,  3.393, 2.034/
        data PAER / 0.345, 0.471,  0.435, 0.328/
        data LAMA0/ 0.439, 0.510,  0.734, 0.412/
        data CAPEL/ 0.122, 0.0827, 1.049, 0.102/
        data K3/116.8,92.40,71.26,53.80,39.92,29.23,21.18,15.23,10.89
     &,   7.776,5.507,3.902,2.760,1.951,1.378,.9725,.6862,.4451,.1697
     &,   4.193E-02,1.036E-02,2.557E-03,6.315E-04,1.6E-04,0.,0.,0.,0.
     &,   3.E-03,3.E-03,3.E-03,7.E-03,1.15E-02,1.5E-02,2.E-02,2.99E-02
     &,   5.30E-02,8.29E-02,0.120,0.124,9.44E-02,6.45E-02,3.91E-02
     &,   2.07E-02,9.21E-03,9.E-03/
        data RAYFAC /   1.5469,1.4923,1.4412,1.3917,1.3443,1.2990,1.2555
     &,   1.2138,1.1739,1.1355,1.0988,1.0635,1.0296,.99702,.96574,.93568
     &,  0.90678,.87248,.80176,.71152,.63362,.56610,.50734,.45600,.41100
     &,  0.37142,.33649,.30557,.27812,.25369,.23187,.21236,.19485,.17912
     &,  0.16494,.14765,.12516,.10391,.086982,.073366,.062314,.053266
     &,  0.045802,.038218,.030051,.023214 /
        data SUNIN /5.74E13, 1.06E14, 8.09E13, 1.39E14, 1.96E14, 2.14E14
     &,    2.12E14, 1.97E14, 2.00E14, 2.05E14, 2.10E14, 2.31E14, 2.36E14
     &,    2.65E14, 2.82E14, 2.88E14, 3.02E14, 4.17E14, 1.61E15, 1.56E15
     &,    1.70E15, 1.80E15, 2.08E15, 2.10E15, 2.07E15, 2.99E15, 3.51E15
     &,    3.67E15, 3.48E15, 4.06E15, 4.57E15, 4.75E15, 4.71E15, 4.89E15
     &,    4.69E15, 4.91E15, 4.97E15, 5.20E15, 5.33E15, 5.30E15, 5.29E15
     &,    5.18E15, 5.08E15, 5.00E15, 4.81E15, 4.57E15/
        data DECLIN / -0.3637, -0.2325, -4.189E-02, 0.1651, 0.3278
     &,   0.4021, 0.3684, 0.2318, 3.438E-02, -0.1717, -0.3320, -0.4035
     &,   0.00/
        data ECCEN / 1.0340, 1.0260, 1.0114, 0.9932, 0.9780, 0.9694
     &, 0.9674, 0.9754, 0.9902, 1.0082, 1.024, 1.0326, 1.00/
        data CCHAR,XTES /'1','0',87.0/
      do 100 I = 1, 4
         AIRVEC(I) = ' '
100   continue
      if (BATCH.gt.0) go to 150
      if (PRSWG.eq.1) go to 130
      NFIRST = NDAT
      NLAST = NDAT
      MEAN = .true.
      print = .false.
      if (NDAT.eq.12) print = .true.
      if (.not.print) go to 110
      TAG = '*'
      NMON = NAMONG(13)
      KOUT = '13'
      go to 120
110   continue
      TAG = ' '
120   continue
      go to 170
130   continue
      if (MODEG.eq.3) go to 140
      MEAN = .false.
      NFIRST = NDAT
      NLAST = NDAT
      print = .true.
      TAG = ' '
      NMON = NAMONG(NDAT)
      write (KOUT,5000) NDAT
5000  format (I2)
      if (KOUT(1:1).eq.' ') KOUT(1:1) = '0'
      go to 170
140   continue
      MEAN = .true.
      print = .true.
      NFIRST = NDAT
      NLAST = NDAT
      TAG = ' '
      NMON = NAMONG(NDAT)
      write (KOUT,5000) NDAT
      if (KOUT(1:1).eq.' ') KOUT(1:1) = '0'
      go to 170
150   continue
      print = .true.
      if (PRSWG.eq.0.and.MONTHG.eq.13) then
         MEAN = .true.
         NFIRST = 1
         NLAST = 12
         TAG = '*'
         NDAT = 13
      else
         MEAN = .false.
         NFIRST = MONTHG
         NLAST = MONTHG
         TAG = ' '
         NDAT = MONTHG
      endif
      NMON = NAMONG(MONTHG)
      write (KOUT,5000) MONTHG
      if (KOUT(1:1).eq.' ') KOUT(1:1) = '0'
      do 160 I = 1, 52
         ACCUM1(I) = 0.0
160   continue
170   continue
      do 280 NBLOC = NFIRST, NLAST
         do 260 LAMBDA = 1, 46
            if (ELEVG.le.5930..and.ELEVG.ge.-100.) go to 180
            write (TTYOUT(MACHNO),5010) ELEVG
5010  format (/1X,'The elevation given for this location (',1PG12.6,' me
     &ters)'/1X,'has been reset to sea level.  ELEVG must',' be in the r
     &ange'/1X,' -100 to 5930 m.'/1X,'(The crater lake on  Lincancabur i
     &n the Andes, at 5930 m.,',' is the'/1X,'highest body of water in t
     &he world (The',' Sciences 24(1):27, 1984).')
            ELEVG = 0.0
180         continue
            YHI = ELEVG/1000.
            I2 = 0
            if (AIRTYG(NBLOC).eq.'R') I2 = 1
            if (AIRTYG(NBLOC).eq.'U') I2 = 2
            if (AIRTYG(NBLOC).eq.'M') I2 = 3
            if (AIRTYG(NBLOC).eq.'T') I2 = 4
            if (I2.gt.0) go to 190
            write (TTYOUT(MACHNO),5020) AIRTYG(NBLOC)
5020  format (' Warning: Air mass type of "',A1,'" is not',' appropriate
     &.'/' AIRTY has been defaulted to "R" (Rural).')
            I2 = 1
            AIRTYG(NBLOC) = 'R'
190         continue
            do 210 I3 = 1, 4
               if (AIRVEC(I3).ne.' ') go to 210
               do 200 J2 = 1, I3
                  if (AIRVEC(J2).eq.AIRTYG(NBLOC)) go to 220
200            continue
               AIRVEC(I3) = AIRTYG(NBLOC)
210         continue
220         continue
            TEMP = RHUMG(NBLOC)
            if (RHUMG(NBLOC).le.99.0.and.RHUMG(NBLOC).ge.0.) go to 230
            if (RHUMG(NBLOC).gt.99.0) RHUMG(NBLOC) = 99.0
            if (RHUMG(NBLOC).lt.0.0) RHUMG(NBLOC) = 50.0
            write (TTYOUT(MACHNO),5030) NAMONG(NBLOC),NBLOC,TEMP,
     &         RHUMG(NBLOC)
5030  format (1X,A4,' relative humidity (RHUMG(',I2,'))',/1X,'was entere
     &d as ',1PG11.4,/' It has been defaulted to',0PF5.1,'%.')
230         continue
            RHUML = RHUMG(NBLOC)/100.
            LAMAR = LAMA0(I2)*(1.+((CAPEL(I2)*RHUML)/((1.-RHUML)**
     &         PAER(I2))))
            ELAM0R = ELAM0(I2)
            if (RHUML.gt.0.) then
               EXPARG = (1./RHUML)**3
               if (EXPARG.le.XTES) ELAM0R = ELAM0(I2)*(1.+((KAER(I2)*
     &            (exp(-EXPARG)))/((1.-RHUML)**PAER(I2))))
            endif
            EXPARG = ((CENLAM(LAMBDA)/1000.)-.3)/LAMAR
            if (EXPARG.gt.XTES) then
               EXTAER(LAMBDA) = 0.0
            else
               EXTAER(LAMBDA) = ELAM0R*exp(-EXPARG)
            endif
            NHI(1) = 1.437/(0.437+exp(YHI/6.35))
            NHI(2) = 1.000
            NHI(3) = (0.13065/(2.35+exp(YHI/2.66)))+(0.970902341/(1.0+
     &         exp((YHI-22.51)/4.92)))
            if (abs(LATG).le.66.5) go to 240
            write (TTYOUT(MACHNO),5040) LATG
5040  format (' System latitude was entered as ',1PG9.3,' degrees.'/' (T
     &he method used by EXAMS to compute daylength'/' is not appropriate
     & for polar latitudes.)'/' LATG has been defaulted to +40.0 degrees
     &.')
            LATG = 40.0
240         continue
            LATL = LATG*0.01745
            SLSD = sin(LATL)*sin(DECLIN(NBLOC))
            CLCD = cos(LATL)*cos(DECLIN(NBLOC))
            TNIGHT = 13751.*acos(-(tan(LATL)*tan(DECLIN(NBLOC))))
            S1 = REFIND(LAMBDA)-1.
            S2 = REFIND(LAMBDA)+1.
            REFRAT = (S1*S1)/(S2*S2)
            S1 = REFIND(LAMBDA)*REFIND(LAMBDA)
            S2 = (S1-1.)/(S1+1.)
            BREW = S2*S2/2.
            RAYDEP(LAMBDA) = RAYFAC(LAMBDA)*NHI(1)
            AERDEP(LAMBDA) = EXTAER(LAMBDA)*NHI(2)*ATURBG(NBLOC)
            OZDEP(LAMBDA) = NHI(3)*K3(LAMBDA)*OZONEG(NBLOC)
            HLAM(LAMBDA) = SUNIN(LAMBDA)*ECCEN(NBLOC)
            EXPARG = RAYDEP(LAMBDA)+AERDEP(LAMBDA)+OZDEP(LAMBDA)
            if (EXPARG.le.XTES) then
               HIBEAM = HLAM(LAMBDA)*exp(-EXPARG)
            else
               HIBEAM = 0.0
            endif
            TAU4 = ABFRAC(LAMBDA)*AERDEP(LAMBDA)
            TAU2 = (1.-ABFRAC(LAMBDA))*AERDEP(LAMBDA)
            FA3 = 1./(1.+(.2864*(OZDEP(LAMBDA)**.8244))*(OZONEG(NBLOC)**
     &         0.4166))
            FA4 = 1./(1.+2.662*TAU4)
            F1 = 0.8041*(RAYDEP(LAMBDA)**1.389)*FA3
            F2 = 1.437*(TAU2**1.12)
            EMM = FA4*(F1+F2*(1.+F1))
            EMMHI = EMM*HIBEAM
            FB3 = 1./(1.+(.2797*(OZDEP(LAMBDA)**.8404))*(OZONEG(NBLOC)**
     &         0.1728))
            FB4 = 1./(1.+3.70*TAU4)
            F1 = 0.4424*(RAYDEP(LAMBDA)**.5626)*FB3
            F2 = 0.100*(TAU2**0.878)
            AIREFL = FB4*(F1+F2)
            TTEE = 0.0266-3.31E-03*YHI
            G3T3 = -OZDEP(LAMBDA)
            GT1GT2 = -(0.5346*RAYDEP(LAMBDA)+0.6077*TAU2)
            EFF = 1./(1.+84.37*((OZDEP(LAMBDA)+TAU4)**.6776))
            ONEFF = 1.-EFF
            TIMER = 0.0
            TINCRL = TNIGHT/5.0
            call SOLFCT (TIMER,YTEMP,GLOLIT)
            XINT(6) = TNIGHT
            YINT(6) = GLOLIT
            do 250 N2 = 1, 5
               TIMER = TIMER+TINCRL
               call SOLFCT (TIMER,YTEMP,GLOLIT)
               XINT(6+N2) = TIMER+TNIGHT
               XINT(6-N2) = TNIGHT-TIMER
               YINT(6+N2) = GLOLIT
               YINT(6-N2) = GLOLIT
250         continue
            WLAML(LAMBDA) = sngl(DINTPT(ELEVEN,XINT,YINT)/86400.)
260      continue
         if (.not.MEAN) go to 280
         ACCUM1(1) = ACCUM1(1)+OXRADG(NBLOC)
         ACCUM1(2) = ACCUM1(2)+RAING(NBLOC)
         ACCUM1(3) = ACCUM1(3)+CLOUDG(NBLOC)
         do 270 II = 4, 49
            ACCUM1(II) = ACCUM1(II)+WLAML(II-3)
270      continue
         ACCUM1(50) = ACCUM1(50)+OZONEG(NBLOC)
         ACCUM1(51) = ACCUM1(51)+ATURBG(NBLOC)
         ACCUM1(52) = ACCUM1(52)+RHUMG(NBLOC)
280   continue
      if (.not.print) go to 360
      if ((.not.MEAN).or.(MODEG.eq.3.and.PRSWG.eq.1.and.NDAT.ne.12)) go
     &   to 320
      do 290 I = 1, 52
         ACCUM1(I) = ACCUM1(I)/12.
290   continue
      OXRADG(13) = ACCUM1(1)
      RAING(13) = ACCUM1(2)
      CLOUDG(13) = ACCUM1(3)
      OZONEG(13) = ACCUM1(50)
      ATURBG(13) = ACCUM1(51)
      RHUMG(13) = ACCUM1(52)
      if (.not.(BATCH.eq.0.and.PRSWG.eq.1.and.MODEG.lt.3.and.MONTHG.eq.
     &   13)) go to 310
      do 300 I = 4, 49
         WLAML(I-3) = ACCUM1(I)
300   continue
310   continue
      if (BATCH.eq.0.and.MODEG.eq.3.and.PRSWG.eq.1.and.NDAT.eq.12) go to
     &    320
      go to 330
320   continue
      III = VRAIL(ECONAM)
      write (RPTLUN(MACHNO),5060) CCHAR(BATCH+1),VERSN,MODEG,(ECONAM(IV)
     &   ,IV=1,III)
      write (RPTLUN(MACHNO),5070)
      write (RPTLUN(MACHNO),5080) KOUT,NMON,TAG
      write (RPTLUN(MACHNO),5070)
      write (RPTLUN(MACHNO),5090) OXRADG(NDAT),RAING(NDAT),CLOUDG(NDAT),
     &   LATG
      write (RPTLUN(MACHNO),5100) OZONEG(NDAT),ATURBG(NDAT),RHUMG(NDAT),
     &   LONGG
      write (RPTLUN(MACHNO),5050) ELEVG,AIRTYG(NDAT)
5050  format (' ELEV (m):',F7.1,4X,'Air mass type: ',A1)
      write (RPTLUN(MACHNO),5120) (WLAML(I),I=1,4)
      write (RPTLUN(MACHNO),5130) (WLAML(I),I=5,46)
      write (RPTLUN(MACHNO),5070)
      if (.not.(BATCH.eq.0.and.PRSWG.eq.1.and.MODEG.eq.3.and.NDAT.eq.12)
     &   ) go to 360
      TAG = '*'
      NMON = NAMONG(13)
      KOUT = '13'
330   continue
      III = VRAIL(ECONAM)
      write (RPTLUN(MACHNO),5060) CCHAR(BATCH+1),VERSN,MODEG,(ECONAM(IV)
     &   ,IV=1,III)
5060  format (A1,'Exposure Analysis Modeling System -- EXAMS Version ', 
     &   F4.2,', Mode',I2/' Ecosystem: ',50A1)
      write (RPTLUN(MACHNO),5070)
5070  format (1X,63('-'))
      write (RPTLUN(MACHNO),5080) KOUT,NMON,TAG
5080  format (' Table 11.',A2,'.  ',A4,' environmental data: ',' global 
     &parameters.',A1)
      write (RPTLUN(MACHNO),5070)
      write (RPTLUN(MACHNO),5090) (ACCUM1(I),I=1,3),LATG
5090  format (' OXRAD (M)',1PG9.2,' RAIN(mm/mo)',0PF6.1,2X,' CLOUD ',   
     &   F7.2,' LAT ',F6.1)
      write (RPTLUN(MACHNO),5100) (ACCUM1(I),I=50,52),LONGG
5100  format (' OZONE(cm)',F6.3,3X,' ATURB(km)',F5.2,5X,' RHUM(%)',F6.1,
     &   ' LONG',F6.1)
      I3 = 1
      do 340 I = 1, 4
         if (AIRVEC(I).eq.' ') go to 350
         I3 = I
340   continue
350   continue
      write (RPTLUN(MACHNO),5110) ELEVG,(AIRVEC(I),I=1,I3)
5110  format (' ELEV (m):',F7.1,3X,' Air mass type(s): ',A1,3(' ',A1))
      write (RPTLUN(MACHNO),5120) (ACCUM1(I),I=4,7)
5120  format (' WLAM, P/cm2/s/N nm: ',1PG10.3,3(G10.3))
      write (RPTLUN(MACHNO),5130) (ACCUM1(I),I=8,49)
5130  format (1X,1PG10.3,G10.3,G10.3,G10.3,G10.3,G10.3)
      write (RPTLUN(MACHNO),5070)
      if (TAG.eq.'*') write (RPTLUN(MACHNO),5140) TAG
5140  format (1X,A1,' Average of 12 monthly mean values.')
360   continue
      return
      end
