      program co_sunset_year
c
c     ------------------------------------------------------------------
c *   calcul des heures de lever et de coucher de Soleil en un point
c     et pour chaque jour d'une annee.
c     ------------------------------------------------------------------
c
      character*32 lieu
      character*12 cmon
      character*8  tmer,tris,tset,durd
      character*8  celemer,cazimer,celeris,caziris,celeset,caziset
      character*8  conv
      character*80 ligne
c
      print 200
      print 200, '====================================================='
      print 200, 'Computation of sunrise and sunset time for one year ;'
      print 200, 'Spherical Earth and constant light refaction assumed.'
      print 200, 'Patrick ROBERT, Rocotlib tools, Jan. 2017.'
      print 200, '====================================================='
      print 200
c 
      print 200, 'year ? ex: 2001'
      read *   , iyear
      print 400, iyear
c
      print 200, 'lat et long en degre, et lieu ? (blank separator)'
c
      read(*,200) ligne
      read(ligne,*) rlat, rlon
c
      call cchapos_(ligne,' ',-1,npos)
      lieu=ligne(npos+1:32)
c
      print 300, rlat, rlon,'   ',lieu
c
      rlat=rlat*3.1415927/180.
      rlon=rlon*3.1415927/180.

      do 10 imon=1,12
c
      call cp_nbday_in_month(iyear,imon,nbday)
      call cp_en_month_name(imon,cmon,ncha)
c
      print 200
      print 200, cmon(1:ncha)
      print 200
      print 100, 'date','tris','eleris','aziris',
     &                  'tmer','elemer','azimer',
     &                  'tset','eleset','aziset','durd'

c
      icor=3
c
      do 10 iday=1,nbday
c
      call cp_sunrise_sunset(iyear,imon,iday,rlat,rlon,tmer,tris,tset,
     &             durd,elemer,azimer,eleris,aziris,eleset,aziset,icor)
c
c *** arondi a la minute la plus proche
c
      call arondi(tris)
      call arondi(tset)
      call arondi(tmer)
      call arondi(durd)
c
      celeris=conv(eleris)
      caziris=conv(aziris)
      celemer=conv(elemer)
      cazimer=conv(azimer)
      celeset=conv(eleset)
      caziset=conv(aziset)

      if(durd(1:5).eq.'00:00') then
                               celeris=' no Sun '
                               celeset=' no Sun '
                               caziris='    -   '
                               caziset='    -   '
                               endif

      if(durd(1:5).eq.'24:00') then
                               celeris=' Sun day'
                               celeset=' Sun day'
                               caziris='    -   '
                               caziset='    -   '
                               endif

      print 400, iyear,imon,iday,tris,celeris,caziris,
     &                           tmer,celemer,cazimer,
     &                           tset,celeset,caziset,durd
   10 continue
c
  100 format(a7,2x,3(a7,2a8),2x,a5)
  200 format(a)
  300 format(2f10.3,2a)
  400 format(i4,'-',i2.2,'-',i2.2,3(2x,a5,2a8),2x,a4)
c
      print 200
      print 200, '****************************************************'
      print 200
       
      stop 'co_sunset_year: normal termination'
      end
c
c     XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX0XX
c
      character*8 function conv(angle)

      character*8 com

      if(angle.lt.0.) angle=angle +360.
      if(angle.gt.360.) angle=angle -360.
      if(angle.lt.0. .or.angle.gt.360.) then
                                        conv='    -   '
                                        return
                                        endif

      ideg=int(angle)
      dec=angle-float(ideg)
      imin=int(dec*60.)

c     write(com,100) ideg,char(176),imin,"'"
      write(com,100) ideg,'d',imin,"'"

  100 format(i4,a1,i2.2,a1)

      conv=com

      return
      end
c
c     XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX0XX
c
      subroutine arondi(tris)
c
c *** arondi tris a la minute la plus proche
c
      character*8 tris
c
      do i=1,8
      if(tris(i:i) .ne. '0' .and.
     &   tris(i:i) .ne. '1' .and.
     &   tris(i:i) .ne. '2' .and.
     &   tris(i:i) .ne. '3' .and.
     &   tris(i:i) .ne. '4' .and.
     &   tris(i:i) .ne. '5' .and.
     &   tris(i:i) .ne. '6' .and.
     &   tris(i:i) .ne. '7' .and.
     &   tris(i:i) .ne. '8' .and.
     &   tris(i:i) .ne. '9' .and.
     &   tris(i:i) .ne. ':' ) return
      enddo
c
      call cchatim_(tris,ih,im,is)
c
      if(is.ge.30) then
                   im=im+1
                   if(im.gt.59) then
                                ih=ih+1
                                im=im-60
                                endif
                   endif
      is=0
c
      call ctimcha_(ih,im,is,tris)
      
      return
      end
c
c     XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX0XX
c
      subroutine cchatim_(ctime,ih,im,is)
c
c     ---------------------------------------------------------------+--
c *   Object : convert_time_character_to_time '13:03:05' to 13 03 05
c *   Class  : convert modules of Rogralib Software
c *   Author : P. Robert, PatCie, 1992
c     ---------------------------------------------------------------+--
c
      character*(*) ctime
c
      read(ctime,100) ih,im,is
c
  100 format(i2,1x,i2,1x,i2)
c
      return
      end
c
c     XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX0XX
c
      subroutine ctimcha_(ih,im,is,ctime)
c
c     ---------------------------------------------------------------+--
c *   Object : convert_time_number_to_char  '13:03:05'
c *   Class  : convert modules of Rogralib Software
c *   Author : P. Robert, PatCie, 1992
c     ---------------------------------------------------------------+--
c
      character*(*) ctime
c
      write(ctime,100) ih,im,is
c
      if(ctime(1:1).eq.' ') ctime(1:1)='0'
      if(ctime(4:4).eq.' ') ctime(4:4)='0'
      if(ctime(7:7).eq.' ') ctime(7:7)='0'
c
  100 format(i2.2,':',i2.2,':',i2.2)
c
      return
      end
c
c     XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX0XX
c
      subroutine cchapos_(chast,cha,isens,npos)
c
c     ---------------------------------------------------------------+--
c *   Object : compute_character_position without end blanks
c *   Class  : compute modules of Rogralib Software
c *   Author : P. Robert, PatCie, 1992
c     ---------------------------------------------------------------+--
c
      character*(*) chast, cha
      
c
      nbc=len(cha)
      if(nbc.ne.1) then
                   print*, '***cha=',cha(1:nbc), ' must be 1 character'
                   print*, '   program aborted'
                   stop '*** program aborted'
                   endif
c
c
      nbc=len(chast)
      if(nbc.gt.255) then
                     print*, '***nbc=',nbc, ' > 255'
                     print*, '   program aborted'
                     stop '*** program aborted'
                     endif
c
c *** dernier caractere non blanc
c
      do 10 i=1,nbc
      ii=nbc-i+1
      if(chast(ii:ii).ne.' ') go to 12
   10 continue
      ii=0
   12 continue
c
      nbcha=ii
c
c *** recherche du caratere cha
c
      do 20 i=1,nbcha
      if (isens.lt.0) then
                      ii=nbcha-i+1
                      else
                      ii=1
      endif
c
      if(chast(ii:ii).eq.cha) go to 22
   20 continue
      print*, '* cchapos: char. ',cha,' not found in ',chast(1:nbcha)
      print*, '           npos set to zero'
      npos=0
   22 continue
      npos=ii
c
      return
      end
c
c     XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX0XX
c
