!c**********************************************************************
!       Takes the file  wk%%%%v%.dat  and makes the plot of the
!       projects  schedule  of two weeks and produces   output files
!       wk%%%%v%.out that contains the number of hours for each
!       project and a postscript file wk%%%%v%%.ps
!       Unix version Dec-96  M.Ruiz
!       Modified Nov-97  M.Ruiz (requested by MG)
!       Modified Mar-98  M.Ruiz (requested by CT)
!       Modified Apr-98  M.Ruiz (requested by CT)
!       /mrt-ux1_users/mrt/ruiz/biweek/biweek.f is this file
!       /thum/sched/progs/bw_01.f        ct modifications 08-apr-1998
!       bw_02.f version No. in fn; LST lines fixed.       mr 20-apr-1998
!       bw_04.f includind four-week option                mr 24-oct-1998
!       different file name for four-week.ps              ct 04-nov-1998
!       new information: sun rise and sun set             mr 02-aug-1999
!       new information: comments of projects             mr 28-aug-1999
!       modifed hsidnew: LST lines do not cross frame     ct 16-oct-1999
!       modification to reset comments                    mr 29-dec-1999
!       small modification to reset comments              mr 20-feb-2000
!       comments written left justified                   ct 20-feb-2000
!       increase no of projects 40->50                    ct 01-mar-2000
!       introduced a space before each / in greg commands ct 14-apr-2000
!       and remove .out file before creating a new one
!       new mappinf features                              mr aug-00
!       keyword=kw001 gifcoor get coordinates             mr aug-00
!       keyword=kw002 makehtml1 make page html            mr aug-00
!       keyword=kw003 makemap   make map for gif          mr aug-00
!       keyword=kw004 makehtml2 make page html            mr aug-00
!       keyword=kw005 convert file ps to gif              mr aug-00
!       comments coordinates in day, hour
!       (now again in x(0..24) y(1..15)                   mr jul-01
!       option to create only some of the html files      mr jul-01
!       compatible with linux                             mr aug-01
!       test to create html files                         mr apr-02
!       correction in version number                      mr may-02
!       error in second file name (4-week)                ct jun-02
!       change in lines width                             mr oct-02
!       change in the name of projects html files         mr oct-02
!       add copy to web page (failed)                     ct jan-03
!       ALL BACKSLASHES-> CHAR(XY)                        hw apr-03
!       reorganization of output to .out file             mr may-03
!       J.Pety version, linked to DELL GILDAS by AWS      as 10-may-04
! sched_03 master on laptop, pety/thum, exec mved to progs   08-jun-04
!       change in coord. when changing dev ps to dev eps  mr 11-jun-04
!       href to DB written html files,mod. yoff           ct 24-Jun-04
!***********************************************************************
!       change of .dat format: proposal part as second column  CT Nov-03
!       moved to RedHat 9 Gildas lib, Fort compiler            jp Feb-05
!       moved directory of html bg files                       ct Feb-05
!       added sched unit to html file names                    ct Jul 05
!       link to HTL files: year No. if sched starts in Dec     ct Nov 05
!       sched_units now have 2 digits                          ct Dec 05
!       removed hardcopy/plot                                  ct Jul 06
!       back to ps file (can now be generated again by GILDAS  ct Jul 06
!       copy to ps file to  thum/www/sched/07                  ct Aug 07
!       some modification for leap year                        mr Nov 08
!       mow copy ps files to www/sched/09                      ct Nov 08
!c**********************************************************************
!
module sched30m_common
  !---------------------------------------------------------------------
  ! Support module for commands SCHEDULE and HARDCOPY
  ! Quick solution for variables shared by both commands.
  !---------------------------------------------------------------------
  character(len=20) :: fil,fil3,fil4,fil5,fil6
  logical :: four
  !
end module sched30m_common
!
subroutine sched30m_schedule_command(line,error)
  use gbl_message
  use gkernel_interfaces
  use sched30m_interfaces, except_this=>sched30m_schedule_command
  !---------------------------------------------------------------------
  ! @ private
  !  Support subroutine for command
  !    SCHEDULE File1 [File2]
  ! Decode the command line
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line
  logical,          intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='SCHEDULE'
  logical :: four
  character(len=36) :: file1,file2
  integer(kind=4) :: nc
  !
  four = sic_present(0,2)
  !
  call sic_ch(line,0,1,file1,nc,.true.,error)
  if (error)  return
  !
  call sic_ch(line,0,2,file2,nc,four,error)
  if (error)  return
  !
  call sched30m_schedule(four,file1,file2,error)
  if (error)  return
  !
end subroutine sched30m_schedule_command
!
subroutine sched30m_schedule(infour,file1,file2,error)
  use gildas_def
  use gbl_message
  use sched30m_interfaces, except_this=>sched30m_schedule
  use sched30m_common
  !---------------------------------------------------------------------
  ! @ private
  !  Support subroutine for command
  !    SCHEDULE File1 [File2]
  ! Do the actual work
  !---------------------------------------------------------------------
  logical,          intent(in)    :: infour
  character(len=*), intent(in)    :: file1
  character(len=*), intent(in)    :: file2
  logical,          intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='SCHEDULE'
  logical    recmark(15,6), found(6), prueba, lsummer,  &
              first, second, fy, algunos, splitblock
  character  name*2,upline*30,mres1*7,p(50)*15,  &
              weeks*5,texto*38,proj(50)*15,dat*11,fil2*20,  &
              author(50)*22, day(16)*2, texto1*20, ans*1,mres2*7,  &
              month(12)*3, cfyear*4,clyear*4,input*80,rxline*20,  &
              cfmes*3,clmes*3,ftuesday*11,ltuesday*11,lupline*30,  &
              cfday*2, clday*2, cdia(16)*2,filefirst*20,crise*3,  &
!                  project_a*8,author_a*22,aut(50)*22,filesecond*20,
              project_a*6,author_a*22,aut(50)*22,filesecond*20,  &
              clst1_a*4,clst2_a*4,cdia_a*2,pro(50)*15,  &
              rx(50)*20,resp*1,chain*132,summer*1,cset*3,  &
              part_a*2,part(50)*2,par(50)*2,part_id*1  !ct 10-11-03
  character  com(22)*60,comm*60,cpx(22)*5,cpy(22)*5,cfact(22)*4
  character  rmtext*60
  character  ficheros(50)*20,su*2
  character(len=commandline_length) :: command
  character(len=filename_length) :: basename
!        real       px(22),pyy(22),fact(22)
!        integer    py(22)
  real       px(22),py(22),fact(22)
  character(len=1), parameter :: blocksepar='-'  ! Block separator

  integer    i,j,t,n,fmes, lmes, fday, lday, daymax(12),jjj,  &
              fyear, lyear ,diamax, dia(16), tt, c(50),no_proj, &
              ho, lastt, m, ancho,dia_a,diap(50,15), &  !CT: (40,8)
              no_ba,no_bla,ii,jj,kk,k,modfyear,version,wk1,wk2
  real       x,y,lst1_a,lst2_a,tim_st(50,15),n_hour(50),  &
              tim_end(50,15),ultdia,n_tot,limtim,yx,yy,yz
  real       rise1,rise2,set1,set2
  real       cpolix(100), cpoliy(100)

  data day   /'  ','TU','WE','TH','FR','SA','SU','MO',  &
              'TU','WE','TH','FR','SA','SU','MO','TU'/
  data month /'JAN','FEB','MAR','APR','MAY','JUN','JUL',  &
              'AUG','SEP','OCT','NOV','DEC'/
  data daymax  /31,28,31,30,31,30,31,31,30,31,30,31/
  data cpolix     /100*0.0/
  data cpoliy     /100*0.0/
  !
        mres1 = ' '
        mres2 = ' '
        !
        if (infour) then
           call gr_exec('set plot_page landsc') !aqui porque hace clear plot
           four   = .true.
           first  = .true.
           second = .false.
        else
           call gr_exec('set plot_page port')
           four   = .false.
           first  = .true.
           second = .false.
        endif

8888    continue
        do i=1,50
           author(i) = '  '
           aut(i) = '  '
           par(i) = '  '
           proj(i) = '  '
           part(i) = '  '                    !CT 08-Dec-2010
           pro(i) = '  '
           rx(i) = '  '
           c(i) = 1
           n_hour(i)=0.0
           do j=1,15  ! antes 8
             diap(i,j)=0.0
             tim_st(i,j)=0.0
             tim_end(i,j)=0.0
           enddo
        enddo

!        do i=1,100
!         write(6,*) i, cpolix(i),cpoliy(i)
!        enddo

        limtim=10.5 ! a partir de esa hora el ultimo dia
        do i=1,15
                do j=1,6
                        recmark(i,j)=.false.
                        found(j)=.false.
                enddo
        enddo
        project_a='  '
        author_a='  '
        n_tot = 0
        no_proj = 0

        if (.not.first) goto 7777
        !
        ! Decode week number and version from file name e.g. wk12v3.dat
        call parse_file_name(file1,basename,wk1,version,error)
        if (error)  return
        fil = trim(basename)//'.dat'
        filefirst = fil
        prueba=.false.
        write (6,*) '  '

7777    continue
        if (first) goto 6666
        if (.not.four) goto 6666
        if (.not.second) goto 6666

        ! Decode week number and version from file name e.g. wk12v3.dat
        call parse_file_name(file2,basename,wk2,version,error)
        if (error)  return
        fil = trim(basename)//'.dat'
        filesecond = fil
        prueba=.false.
6666    continue

!       write (6,1850)
!1850   format(1x,' Enter P (Preview) or D (definitive) > ',$)
!       read (5,'(a)') resp
!       call sic_upper(resp)
        resp='D'
        if(resp.ne.'P') prueba=.false.

        fil = filesecond
        if (first) fil = filefirst

        open (unit=91,file=fil,status='old',err=366)
        print *,'** file opened: ', fil
        goto 469
366     print *, ' - cannot read file name:',fil,' try again.-'
        goto 8888
469     continue
        rewind(unit=91)
!       call gr_exec('set /def')
        call gr_exec('penc /def')
        call gtclal  ! CLEAR ALPHA
!       call gr_exec('clea plot')
!1011    format(a8,2x,a22,3x,a2,2x,a4,5x,a4,2x,a20)
1011    format(a6,1x,a2,1x,a22,3x,a2,2x,a4,5x,a4,2x,a20)
1013    format(a5,3x,a5,3x,a4,4x,a60)
!***********************************************************************
!c      Reading the file
!***********************************************************************
        read (91,'(a2)') name
        call sic_upper(name)
        read (91,'(a1)') summer
        call sic_upper(summer)
                if(summer.eq.'Y') then
                  lsummer=.true.
                  texto1='MEST = UT + 2 hours'
                  ho=6
                else
                  lsummer=.false.
                  texto1='MET = UT + 1 hour'
                  ho=7
                endif
        read (91,'(a11)') dat
        call sic_upper(dat)
        read (91,'(a5)') weeks
        read (91,'(i4)') fyear
        write(cfyear,'(i4)')  fyear
        modfyear = mod(fyear,4)
        read (91,'(i4)') fmes
        if(fmes.gt.12) then
          write(6,*) 'Error in month number, correct the file'
          error = .true.
          return
        endif
        read (91,'(i4)') fday
!       fyear=fyear+1900
!        if(modfyear.eq.0) daymax(2)=29        !leap year
!        if(mod(fyear,4).eq.0) daymax(2)=29              !leap year
!       fyear=fyear-1900
        write(cfday,'(i2.2)')   fday
!
      daymax(2)=28
      do i=1,12
           if (fmes.eq.i) then
             jjj=i
             if(modfyear.eq.0) daymax(2)=29        !leap year
             diamax=daymax(i)
             cfmes=month(i)
           endif
!       write (6,*) i,daymax(i),diamax, fil, fyear, modfyear
        enddo
!
!       write (6,*) 'hola'
!       write (6,*) jjj,daymax(jjj),diamax, fil, fyear, modfyear

!        pause
        if(fday.gt.diamax) then
          write(6,*) 'Error in day number, correct the file'
          error = .true.
          return
        endif
        lday=fday+14
        if(lday.gt.diamax) lday=lday-diamax
        lmes=fmes
        lyear=fyear
        if(lday.le.14) lmes = fmes+1
        if(lmes.eq.13) then
           lmes = 1
           lyear = fyear+1
        endif
        do i=1,12
           if (lmes.eq.i) clmes=month(i)
        enddo
        write(clday,'(i2.2)')   lday
        write(clyear,'(i4)')  lyear
        ftuesday=cfday//'-'//cfmes//'-'//cfyear
        ltuesday=clday//'-'//clmes//'-'//clyear
        dia(2)=fday
        dia(1)=fday-1
        write(cdia(2),'(i2.2)')  dia(2)
        write(cdia(1),'(i2.2)')  dia(1)
        do i=3,16
           dia(i)=dia(i-1)+1
           if(dia(i).eq.diamax+1) dia(i)=1
           write(cdia(i),'(i2.2)')  dia(i)
        enddo
        cdia(1) = ' '
!       write(ifyear,'(i4)') fyear
!******************************************************************
!************  getting info of set sun and set rise
!******************************************************************
        call sunpos (fyear,fmes,fday,rise1,set1)
        call sunpos (lyear,lmes,lday,rise2,set2)

        rise1=rise1+1.0         ! ut+1 winter time
        rise2=rise2+1.0
        set1=set1+1.0
        set2=set2+1.0
        if(lsummer) then
         rise1=rise1+1.0        ! ut+2 summer time
         rise2=rise2+1.0
         set1=set1+1.0
         set2=set2+1.0
        end if
!
!       print*,'fecha, rise1, set1',fyear,fmes,fday,rise1,set1
!       print*,'fecha, rise2, set2',lyear,lmes,lday,rise2,set2
!       pause
!******************************************************************
        read (91,'(a)') input ! 3 comments lines
        read (91,'(a)') input
        read (91,'(a)') input
        i = 0
        ancho  =0
        ultdia =0
        splitblock = .false.
!40      read (91,1011,END=11)  project_a,author_a,cdia_a,clst1_a,
!     1                          clst2_a,rxline
40      read (91,1011,END=11)  project_a,part_a,author_a,cdia_a,clst1_a,  &
                                clst2_a,rxline

        px(:) = 0.
        py(:) = 0.
        fact(:) = 0.
        if(project_a(1:1).eq.'!') goto 40
        if(project_a(1:1).eq.blocksepar) then
          splitblock = .true.
          goto 40
        endif
        if(project_a(1:2).eq.'**') then
           read (91,'(a)') input ! jump next 3 comm. lines !mod. CT 06-09-99
           read (91,'(a)') input
           read (91,'(a)') input
           do j=1,22
             com(j)='  '  ! new mr
           enddo
           do j=1,22
!c             read (91,1013,END=11)  cpy(j),cpx(j),cfact(j),com(j)
              read (91,1013,END=11)  cpx(j),cpy(j),cfact(j),com(j)
!             call sic_upper(cpy(j))
!             if(cpy(j)(1:4).eq.'STOP') then
              call sic_upper(cpx(j))
             if(cpx(j)(1:4).eq.'STOP') then
                com(j)=' '
                goto 11
             endif
             no_ba=0
             do t=1,60
               if(com(j)(t:t+1).eq.'  ') no_ba=no_ba+1
! !mod. CT 19-02-00
             enddo
             no_bla = int(float(no_ba)/2.)
             comm='  '
!            comm(no_bla+1:60)=com(j)
!            com(j)=comm
             comm(1:no_ba)=com(j)
!       if(cpy(j)(1:4).eq.'STOP') goto 11        !mod. CT 06-09-99
             read (cpx(j),'(f5.2)') px(j)
             read (cpy(j),'(f5.2)') py(j)

!       px is now in hours (0..24), py is in day of the date
!
             if (abs(py(j)-98.).le.0.1) then
                py(j) = fday+22.8                 !remark above left bottom
                px(j) = -1.5
             elseif (abs(py(j)-99.).le.0.1) then
                py(j) = fday+22.8                 !remark above right bottom
                px(j) = 11.8
             elseif(py(j).lt.fday) then
                py(j) = py(j) + diamax            !when py after end of month
             endif
             px(j) = (px(j)-1)/24*0.89+0.10
             py(j) = - 0.83*1./15.*(py(j)-fday+0.5) + 0.89
             read (cfact(j),'(f4.2)') fact(j)
!            print *, ' ** px,py: ', px(j), py(j)
           enddo
        endif            !end if(project_a(1:2).eq.'**') then

        i=i+1
        read (cdia_a,'(i2.2)')  dia_a
!       print *, ' dia_a:', dia_a
        read (clst1_a,'(f9.1)') lst1_a
        read (clst2_a,'(f9.1)') lst2_a
        proj(i)=project_a
        part(i)=part_a
        if (i.gt.1) then
           if (splitblock) then
              ! Force split project in a new block
              splitblock = .false.
           elseif (proj(i).eq.proj(i-1)) then
              ! Same project
              i=i-1
              c(i)=c(i)+1
              proj(i+1)= ' '
              par(i+1) = ' '
          endif
        endif
        proj(i)=project_a
        pro(i)=proj(i)
        part(i)=part_a
        par(i) =part(i)
        author(i)=author_a
        aut(i)=author(i)
        rx(i)=rxline
        diap(i,c(i))=dia_a
        tim_st(i,c(i)) =lst1_a
        tim_end(i,c(i))=lst2_a
        no_proj=i
!**********************************************************************
! MR modif. jan-94
        do k=1,no_proj-1
                if(proj(i).eq.proj(k)) then
                      n_hour(k)=n_hour(k)-lst1_a+lst2_a
                      goto 3131
                endif
        enddo
        if(diap(i,c(i)).ne.diap(i,c(i)-1)) then !do not repeat account of hours
           n_hour(i)=n_hour(i)-lst1_a+lst2_a
        endif

3131    continue
        if(dia_a.eq.float(fday)) then
                if((lst1_a.le.limtim).and.(lst2_a.le.limtim)) then
                        n_hour(k)=n_hour(k)-(lst2_a-lst1_a)
                else if((lst1_a.le.limtim).and.(lst2_a.ge.limtim)) then
                        n_hour(k)=n_hour(k)-(limtim-lst1_a)
                endif
        endif
        if(dia_a.eq.float(lday)) then
                if((lst1_a.ge.limtim).and.(lst2_a.ge.limtim)) then
                        n_hour(k)=n_hour(k)-(lst2_a-lst1_a)
                else if((lst1_a.le.limtim).and.(lst2_a.ge.limtim)) then
                        n_hour(k)=n_hour(k)-(lst2_a-limtim)
                endif
        endif
!**********************************************************************
        call sic_upper(rxline)
        upline=rxline
        do t=1,15
           if(dia(t+1).eq.dia_a) then
             lastt=t
             if(rxline.ne.'  ') then
                do m=1,6
                   found(m)=.false.
                enddo
             do j=1,20
                if(upline(j:j+3).eq.'3MM1') found(1)=.true.
                if(upline(j:j+4).eq.'230G1') found(2)=.true.
                if(upline(j:j+3).eq.'2MM1') found(3)=.true.
                if(upline(j:j+2).eq.'CON') found(4)=.true.
                if(mres1(1:5).eq.'230G2') then
                 if(upline(j:j+4).eq.mres1(1:5)) found(5)=.true.
                else if(mres1(1:3).eq.'0.8') then
                 if(upline(j:j+2).eq.mres1(1:3)) found(5)=.true.
                else if(mres1(1:3).eq.'BOL') then
                 if(upline(j:j+2).eq.mres1(1:3)) found(5)=.true.
                else
                 if(upline(j:j+3).eq.mres2(1:4)) found(5)=.true.
                endif

                if(mres2(1:5).eq.'230G2') then
                 if(upline(j:j+4).eq.mres2(1:5)) found(6)=.true.
                else if(mres2(1:3).eq.'0.8') then
                 if(upline(j:j+2).eq.mres2(1:3)) found(6)=.true.
                else if(mres2(1:3).eq.'BOL') then
                 if(upline(j:j+2).eq.mres2(1:3)) found(6)=.true.
                else
                 if(upline(j:j+3).eq.mres2(1:4)) found(6)=.true.
                endif

             enddo
                do m=1,6
                   if(found(m)) recmark(t,m)=.true.
                enddo

             endif
             if(rxline.eq.'  ') then
              if(c(i).ge.2) then
                ancho=int(dia_a-ultdia+1)
                do j=2, ancho
                   do n=1,6
                      if(found(n)) then
                        if (.not.recmark(t-ancho+j,n)) then
                           recmark(t-ancho+j,n)=recmark(t+1-ancho,n)
                        endif
                      endif
                   enddo
                enddo
              else
                do j=1,6
                   found(j)=.false.
                enddo
              endif
            endif
           endif
        enddo
        lupline=upline
        ultdia=dia_a

        goto 40        !loop reading the .dat file

11      continue       !jump to here after reading STOP in .dat file
        do i=1,no_proj
          p(i)=pro(i)
          call sic_upper(p(i))
          do j=1,4
              if((p(i)(j:j+3).eq.'mtn').or.  &
                 (p(i)(j:j+2).eq.'ptg').or.  &
                 (p(i)(j:j+2).eq.'TBA').or.  &
!                (p(i)(j:j+1).eq.'TT').or.   &
!                (p(i)(j:j+3).eq.'TECH').or. &
                 (p(i)(j:j+3).eq.'RESE').or. &
                 (p(i)(j:j+3).eq.'RX S').or. &
                 (p(i)(j:j+3).eq.'BOLO').or. &
                 (p(i)(j:j+2).eq.'mon')) then
                        pro(i)='    '
                        aut(i)='    '
                        rx(i)='    '
                        par(i)='  '
                endif
          enddo
        enddo
        do i=no_proj,1,-1
           do j=1,i-1
                if(pro(i).eq.pro(j)) then
                   pro(i)='  '
                   par(i)='  '
                   aut(i)='  '
                   rx(i)='  '
                endif
           enddo
        enddo
        do i=1,no_proj
           if(pro(i).eq.'  ') then
                do j=i+1,no_proj
                   if(pro(j).ne.'  ') then
                        pro(i) = pro(j)
                        par(i) = par(j)
                        aut(i) = aut(j)
                        rx(i)  = rx(j)
                        pro(j) = '  '
                        par(j) = '  '
                        aut(j) = '  '
                        rx(j)  = '  '
                        goto 111
                   endif
                enddo
111             continue
           endif
        enddo

        if (.not.four) then
           call gr_exec('set box 0.5 20.5 9.0 25.0 ')
        endif

        if (four) then
           if (first) then
            call gr_exec('set box 0.30 14.8 5.5 17.75 ')
           else
             call gr_exec('set box 15.40 29.9 5.5 17.75 ')
           endif
        endif

        write (6,*) '  '
        texto='OBSERVING SCHEDULE IRAM 30m TELESCOPE'
!       goto 9999 !para saltar graficas durante tests
        call gtclal

!       +++++++++++++++++++++++++++++++++++++++++++++++++++++++
!       +++                  Using Greg                     +++
!       +++++++++++++++++++++++++++++++++++++++++++++++++++++++

        call gr_exec('box n n n')
        call gr_exec('set expand 1.20')

        if (four) call gr_exec('set expand 0.90')

        call gr_exec('set font dupl')
        if(prueba) call gr_exec('set font simpl')
!       if(four) call gr_exec('set font simpl')
        call gr_exec('pencil 1')
        call gr_exec('draw text 0.50 1.18 "'//Texto//'" 8 /USER')
        call gr_exec('set expand 1.00')

        if (four) call gr_exec('set expand 0.77')
        call gr_exec('draw text 0.45 1.14 "'//ftuesday//'" 4 /USER')
        call gr_exec('draw text 0.50 1.14 " to " 5 /USER')
        call gr_exec('draw text 0.55 1.14 "'//ltuesday//'" 6 /USER')
        call gr_exec('set expand 0.85')

        if (four) call gr_exec('set expand 0.58')
        call gr_exec('draw text 0.00 1.09 "Weeks: " 6 /USER')
        call gr_exec('draw text 0.10 1.09 "'//Weeks//'" 6  /USER')
        call gr_exec('draw text 0.00 1.04 "Version:" 6 /USER')
        write(command,'(A,I0,A)') 'draw text 0.11 1.04 "',version,'" 6 /USER'
        call gr_exec(command)
        call gr_exec('draw text 0.94 1.09 "By:" 4 /USER')
        call gr_exec('draw text 1.00 1.09 "'//name//'" 4 /USER')
        call gr_exec('draw text 0.80 1.04 "Date:" 4 /USER')
        call gr_exec('draw text 1.00 1.04 "'//Dat//'" 4 /USER')

        call gr_exec('set expand 0.65')

        if (four) call gr_exec('set expand 0.50')
        call gr_exec('pencil /defa')

        call gr_exec('draw text 0.500 0.955 "'//Texto1//'" 5 /USER')
        call gr_exec('draw text 0.0390 0.94 "DAY" 5 /USER')

!c
!c      new format to write projects, authors and receiver information (CT)
!c
!c      line to separate projects

        call gr_exec('draw relocate 0.500 0.00 /USER')
        call gr_exec('draw line 0.500 -0.420 /USER')
        call gr_exec('draw relocate 0.497 0.00 /USER')
        call gr_exec('draw line 0.497 -0.420 /USER')

        call gr_exec('draw relocate 0.00 0.00 /USER')
        call gr_exec('draw line 0.00 -0.420 /USER')

        call gr_exec('draw relocate 1.00 0.00 /USER')
        call gr_exec('draw line 1.00 -0.420 /USER')

        call gr_exec('draw relocate 0.00 -0.420 /USER')
        call gr_exec('draw line 1.00 -0.420 /USER')

!       do i=13,20
!          pro(i)='999-99'
!          aut(i)='clemens thum'
!          rx(i)='2m 3m1 g2'
!          enddo

        if (four) call gr_exec('set expand 0.47250') !antes 0.475

        do i=1,19, 2
           y=-0.03-(i-1)*0.02

           x=0.005
           write(chain,1022) x,y,Pro(i)
!1022      format ('draw text' ,2(1x,f5.3),' " ',a6,' " 3 /USER')
1022       format ('draw text' ,2(1x,f5.3),' " ',a8,' " 3 /USER')  !CT 11-12-98
           call gr_exec (chain)

           x=0.090           !0.115             !0.135
           write(chain,1023) x,y,Aut(i)
1023       format ('draw text' ,2(1x,f5.3),' " ',a22,' " 3 /USER')
           call gr_exec (chain)

           x=0.280
           write(chain,1024) x,y,Rx(i)
1024       format ('draw text' ,2(1x,f5.3),' " ',a20,' " 3 /USER')
           call gr_exec (chain)
        enddo

        do i=2,20, 2
           y=-0.03-(i-2)*0.02
           x=0.510
           write(chain,1025) x,y,Pro(i)
!1025      format ('draw text' ,2(1x,f5.3),' " ',a6,' " 3 /USER')
1025       format ('draw text' ,2(1x,f5.3),' " ',a8,' " 3 /USER')   !CT 11-12-98
           call gr_exec (chain)

           x=0.595
           write(chain,1026) x,y,Aut(i)
1026       format ('draw text' ,2(1x,f5.3),' " ',a22,' " 3 /USER')
           call gr_exec (chain)

           x=0.785
           write(chain,1027) x,y,Rx(i)
1027       format ('draw text' ,2(1x,f5.3),' " ',a20,' " 3 /USER')
           call gr_exec (chain)
        enddo

!       call gr_exec('draw text 0.04 3.7E-02 "LST" 5 /USER')
!       call gr_exec('draw relocate 0.07 3.6E-02 /USER')
!       call gr_exec('draw arrow 0.09 3.7E-02 /USER')
        call gr_exec('draw text 0.03 3.7E-02 "LST" 5 /USER')
        call gr_exec('draw relocate 0.06 3.6E-02 /USER')
        call gr_exec('draw arrow 0.08 3.7E-02 /USER')

        call hsidnew(fyear,fmes,fday,0,0,-3.,-23.,-58.1,lsummer)
        call hsidnew(fyear,fmes,fday,8,0,-3.,-23.,-58.1,lsummer)
        call hsidnew(fyear,fmes,fday,16,0,-3.,-23.,-58.1,lsummer)

!******** lines of sun rise and sunset ***********
        yz=0.888
        yy=0.015
        yx=0.130
        rise1=rise1*0.037037+0.095 ! change to user coord.
        rise2=rise2*0.037037+0.095
        set1=set1*0.037037+0.095
        set2=set2*0.037037+0.095
!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
!c
!c      new line of the sun
!c
        call gr_exec('pencil /dash 3 /weig 1')
        write (chain,2236) rise2,yy
2236    format ('draw relo',2(1x,f7.4),' /CLIP')
        call gr_exec (chain)
        write (chain,2246) set2,yy
2246    format ('draw lin',2(1x,f7.4),' /CLIP')
        call gr_exec (chain)

        call gr_exec('pencil /dash 1 /weig 1')

!***********************************************************************
!c      sun symbol instead of characters
!        crise='0'
!        cset='0'
        crise=char(92)//'g0'  ! sun symbol
        cset =char(92)//'g0'
!        pause !ya no es necesaria la pausa, se ha arreglado al poner
!        la linea del sol antes que los simbolos
        write (chain,2247) rise2,yy,crise
2247    format ('draw text',2(1x,f7.4),' " ',a3,' " 5 /USER /CLIP')
        call gr_exec (chain)
        write (chain,2248) set2,yy,cset
2248    format ('draw text',2(1x,f7.4),' " ',a3,' " 5 /USER /CLIP')
        call gr_exec (chain)
!***********************************************************************
        call gr_exec('pencil /dash 3 /weig 1')
        do i=2,17
                x  = 1.0-(float(i)/18.0)
                t  = i-1
                tt = i-1
                call horizline(x,day(t),cdia(tt),prueba,four)
        enddo
        do i=1,25
                x = 0.095+(i-1)*0.0370834
                t = i
                call vertline(x,t,prueba,four)
        enddo
        call gr_exec('pencil /dash 1 /weig 1')
!***********************************************************************
!cc        pause !p3
!55     continue
        write(fil5,'(A,I0,A)')  's'//fil(3:4)//'v',version,'.html'  !nuevo fichero mr
        write(fil6,'(A,I0,A)')  's'//fil(3:4)//'v',version,'.gif'   !nuevo fichero mr
!        fil5='test.html'
!        print*, fil5,fil6
!        pause
!cccccccccccccccc
!        do i=1,no_proj
!c        ficheros(i)='p'//proj(i)(1:index(proj(i),' ')-1)//'.html'
!        if(proj(i)(1:3).eq.char(92)//'gD') then
!          ficheros(i)=fil5(1:5)//'_d'//proj(i)(4:5)//'.html'
!         else
!           ficheros(i)=fil5(1:5)//'_'//proj(i)(1:3)//'.html'
!        endif
!c         print*, ficheros(i)
!c         pause
!        enddo
!cccccccccccccc a continuacion cambio las lineas anteriores para
!cccccccccccccc modificar el nombre de ficheros html de cada proyecto
!cccccccccccccc para que no incluya la version
        do i=1,no_proj
!        ficheros(i)='p'//proj(i)(1:index(proj(i),' ')-1)//'.html'
!        if(proj(i)(1:3).eq.char(92)//'gD') then
!          ficheros(i)=fil5(1:3)//'_d'//proj(i)(4:5)//'.html'
!         else
!           ficheros(i)=fil5(1:3)//'_'//proj(i)(1:3)//'.html'
!        endif

!     19-Jul-2005 added scheduling unit No. to html file name
!
!        print *,proj(i),' part(i)=', part(i),'===='
!        print *,'par(i)(1:2)=', par(i)(1:2),'===='
        if (part(i)(1:1).eq.' ') then
          su = '0'//part(i)(2:2)
          if (part(i)(2:2).eq.' ') then
             su = '00'
          endif
        else
          su = part(i)(1:2)
        endif

        ficheros(i) = fil5(1:3)//'_'//trim(proj(i))//'_su'//su//'.html'

!        print*,part(i), ' - ', ficheros(i)
!         pause
        enddo

!cc     call to graphic subroutine
        do i=1,no_proj
        j=c(i)
        ii=i
        jj=j
        kk=j
        call displ_proj(proj(i),diap,tim_st,tim_end,i,j,dia,prueba,four)
        enddo  !hoy

!c**********************************************************************
!c          new comments part
!c**********************************************************************
        call gr_exec('set ori 0')
        do j=1,21
!          print*, px(j),py(j),fact(j),com(j)
!          pause 33
!          call gr_exec('set expand 1.0')
           if (four) fact(j)=0.75*fact(j)
           write (chain,2347) fact(j)
2347       format ('set expand',(1x,f4.2))
           call gr_exec (chain)
           call gr_exec('pencil /dash 1 /weig 2')
           write (chain,2348) px(j),py(j),com(j)
!           write (chain,2348) px(j),pyy(j),com(j)
!2348      format ('draw text',2(1x,f5.3),' " ',a60,' " 5 /USER')
2348       format ('draw text',2(1x,f5.3),' " ',a60,' " 6 /USER')   !CT 2-11-99
           call gr_exec (chain)
           call gr_exec ('penc /defa')
        enddo
!***********************************************************************
! file *.out with info of number of hours
!***********************************************************************
        part_id = '='          !identifies the part number in .out file
        fil2=fil(1:index(fil,'.')-1)//'.out'
!       open (unit=92,file=fil2,defaultfile='[thum.sched.planning].dat',
!     1        status='unknown')
        rmtext = 'rm -f fil2'
        call system(rmtext)
        open (unit=92,file=fil2,status='unknown')
        write (92,1318) fil2
        write (92,1314)
        write (92,1315)
        do i=1,no_proj
                n_tot=n_tot+n_hour(i)
        enddo
        write (92,1316) proj(1),part(1),part_id,n_hour(1)
        print *,proj(1),part(1),n_hour(1)
        do i=2,no_proj
                do j=1,i-1
                        if(proj(j).eq.proj(i)) then
                           goto 1322
                        else

                        endif
                enddo
                if(n_hour(i).ne.0) then
                   write (92,1316) proj(i),part(i),part_id,n_hour(i)
                   print *,proj(i),part(i),n_hour(i)
                endif
1322            continue
        enddo
        write (92,1317) n_tot,n_tot*100./336.
1314    format('!',10x,'Project ',10x,'Part',5x,'Hours ')
1315    format('!',10x,'------- ',10x,'----',5x,'----- ')
1316    format(7x,a15,7x,a2,a,7x,f5.1)
1317    format('!',10x,'Total:  ',10x,f5.1,'  Hours (=',f5.1,'%)')
1318    format('!',10x,'File:  ',a20)
        close(unit=92)

        do i=1,no_proj
        j=c(i)
        ii=i
        jj=j
        kk=j

! kw001 gifcoor
        call gifcoor(proj(i),diap,tim_st,tim_end,ii,jj,dia,cpolix,cpoliy)

! kw002 makehtml1
        if(i.eq.1) call makehtml1(i,fil5,fil6)

! kw003 makemapq
3232    continue
!        if(i.eq.1) then
!          write(6,'(1x,a,$)') 'create html file (y/n), some(s)? > '
!          we only write the main html file here; the project files
!          are now written from the DB (Jan 2005)
!          write(6,'(1x,a,$)') 'create html file (y/n) ? > '
!          read (5,'(a1)') ans
!          if (ans.eq.' ') ans = 'n'
!           write(6,*) rmtext2
!           call system(rmtext2)

!          if (ans.eq.'y') then
!            write(6,'(1x,a,$)') 'are you sure you typed y? (y/n)> '
!            read (5,'(a1)') ans
            ans = 'y'
            if (ans.ne.'y') goto 3232
!          endif
!          fy=.false.
!          algunos=.false.
!          if((ans.eq.'y').or.(ans.eq.'Y')) fy=.true.
!          if((ans.eq.'s').or.(ans.eq.'S')) algunos=.true.
!        endif
!        print *,'cfyear=',cfyear
        fy=.true.
!        print *, 'fyear=',fyear,' fmes= ',fmes
        algunos = .false.                           !CT 08-dec-2010
        call makemap(fy,algunos,i,ficheros,proj,kk,cpolix,cpoliy,fyear,fmes)

!kw004 makehtml2
        if(i.eq.no_proj) call makehtml2(i,fil5)
        enddo
        close(96)

        call gr_exec('pencil /dash 1 /weig 1')

        fil3=fil(1:index(fil,'.')-1)//'.ps '

!***********************************************************************
        close(unit=91)
        if ((four).and.(second)) goto 5151
        if (four) then
           first  = .false.
           second  = .true.
           goto 8888
        endif
5151    continue
        write(fil4,'(A,I2.2,I2.2,A)') 'tmp',wk1,wk2,'.ps'

        call gr_exec('set expand 0.90')
        call gr_exec('pencil /dash 1 /weig 2')
        call gtclal  ! CLEAR ALPHA

end subroutine sched30m_schedule
!
subroutine sched30m_hardcopy_command(line,error)
  use sched30m_interfaces, except_this=>sched30m_hardcopy_command
  !---------------------------------------------------------------------
  ! @ private
  !  Support subroutine for command
  !    HARDCOPY
  ! Decode the command line
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line
  logical,          intent(inout) :: error
  !
  ! Nothing to be decoded
  call sched30m_hardcopy(error)
  if (error)  return
  !
end subroutine sched30m_hardcopy_command
!
subroutine sched30m_hardcopy(error)
  use sched30m_common
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  logical, intent(inout) :: error
  ! Local
  character(len=60) :: cptext
  character(len=27) :: defdir
  character(len=160) :: rmtext2
  character(len=36) :: webdir
  !
  if (four) then
    call gr_exec('hard "'//fil4//'" /dev eps fast /overwrite')
    !
  else
    print *, 'fil3: ', fil3
    call gr_exec('hard "'//fil3//'" /dev ps fast /overwrite')
!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
!          para crear fichero gif, ya funciona en Granada
!kw005 convert
!           write(6,*) fil3,fil6
!           rmtext2= 'convert '//fil3//' '//fil6
    rmtext2= 'convert +antialias -density 300 '//fil3//  &
    ' -type trueColor -resample 72 -contrast '//fil6
    write(6,*) rmtext2
    call system(rmtext2)
!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  endif

!  Jan 03 modification: cp files to new web page
  webdir = '/netapp1/www/html/IRAMFR/PV/sche/03/'
  defdir = '/users/astro/thum/sched/03/'

! write(6,'(1x,a,$)') 'copy html,gif files to web? (y/n) > '
! read (5,'(a1)') ans
! if (ans.eq.' ') ans = 'n'
  if (.false.) then
!  cptext = 'newgrp web; ls'
!  write(6,*)  '- execute: ', cptext
!  call system(cptext)
!  cptext = 'cd '//webdir//'; pwd'
!  write(6,*)  '- execute: ', cptext
!  call system(cptext)
    cptext = 'cp '//defdir//fil5//' '//webdir//'.'
    write(6,*) cptext
    call system(cptext)
    cptext = 'cp '//defdir//fil6//' '//webdir//'.'
    write(6,*) cptext
    call system(cptext)
    cptext = 'ls '//webdir//' | pwd'
    write(6,*) cptext
    call system(cptext)
  endif

!  copy ps file to publicly reachable dir (for Juan) CT 22-08-07
!  This action is not required anymore so I comment it out (NB Dec. 2011)
!        webdir = '/users/astro/thum/www/sched/09/'
!        cptext = 'cp '//fil3//' '//webdir//'.'
!C       print *, 'copying:', cptext
!        write(6,*) cptext
!        call system(cptext)

end subroutine sched30m_hardcopy
!
!***********************************************************************

        subroutine horizline(t,nom,ddia,pr,ff)
        real      x, t
        character chain*80, nom*2, ddia*2
        logical   pr,ff

        t=t+0.025
        x= -0.0055

        write(chain,225) x,t,nom
225     format ('draw text',2(1x,f7.4),' "',1(1x,a2),'" 6 /USER')
        call gr_exec('set exp 0.85')
        if (ff) call gr_exec('set expand 0.635') !antes 0.65

        call gr_exec (chain)
        x=0.0780
        write(chain,226) x,t,ddia
226     format ('draw text',2(1x,f7.4),' "',1(1x,a2),'" 4 /USER')
!       call gr_exec('set exp 0.85')
        call gr_exec (chain)
        x= 0.0
        t=t-0.025
        if(pr) goto 2223
        write(chain,222) x,t
222     format ('draw rel ',2(1x,f7.4))
        call gr_exec (chain)
        x=1.0
        write(chain,223) x,t
223     format ('draw lin',2(1x,f7.4))
        call gr_exec (chain)
2223    x=0.0
        return
        end subroutine horizline

!***********************************************************************

        subroutine vertline(z,hora,pru,ff)
        real      y, z
        character chain*80, chora*2
        integer   hora
        logical   pru,ff

        hora=hora-1
!       write(chora,'(i2.2)') hora
        write(chora,'(i2)') hora
        y=0.058
        if(pru) goto 2222
        write(chain,222) z,y
222     format ('draw rel ',2(1x,f7.4))
        call gr_exec (chain)
        y= 0.91
        write(chain,223) z,y
223     format ('draw lin',2(1x,f7.4))
        call gr_exec (chain)
2222    y= 0.91
        y=y+0.005
        call gr_exec('set exp 0.50')
        if (ff) call gr_exec('set expand 0.38') !antest 0.4
        if(hora.lt.10) z=z-0.002
        write(chain,323) z,y,chora
323     format ('draw text',2(1x,f7.4),' "',a2,'" 8 /USER')
        call gr_exec (chain)
        return
        end subroutine vertline
!***********************************************************************

        subroutine displ_proj(proje,diap,tim_st,tim_end,s,t,diaa,prueba,ff)
        character  proje*15, chain*80, pr*15
        integer    i, j, s, t, p, u, diaa(16), no_b, no_bl,a1,a2
!       integer    diap(40,8)
        integer    diap(50,15)
!       real       tim_st(40,8),tim_end(40,8),corr
        real       tim_st(50,15),tim_end(50,15),corr
!        real       x(400), y(400), xave, yave, height, width,z
        real       x(100), y(100), xave, yave, height, width,z

        logical    anga,prueba,ff
!        data x     /400*0.0/
!        data y     /400*0.0/
        data x     /100*0.0/
        data y     /100*0.0/

        anga   = .false.
        corr   = 0.0033
        a1     = 0.0
        a2     = 0.0
        xave   = 0.0
        yave   = 0.0
        height = 0.0
        width  = 0.0
        u=t

!        write(6,*) t,proje
!        pause

        do j=1,t
        p = j-1
          do i=1,16
            if(diap(s,j).eq.float(diaa(i))) then
                if(j.eq.1) a1=diaa(i)
                if(j.eq.t) a2=diaa(i)
                x(2*p+1) = (tim_st(s,j))*0.0370834 + 0.095
                x(2*p+2) = x(2*p+1)
                x(4*u-2*p-1) = (tim_end(s,j))*0.0370834 + 0.095
                x(4*u-2*p) = x(4*u-2*p-1)
                y(2*p+1) = 1-(float(i)/18.)
                y(2*p+2) = 1-(float((i+1))/18.)
                y(4*u-2*p-1) = y(2*p+2)
                y(4*u-2*p) = y(2*p+1)
                p = p+1
            endif
          enddo
          width=width+tim_end(s,j)-tim_st(s,j)
        enddo
        height=float(t)
        width=width/float(t)
        do i=1,4*u
           xave=xave+x(i)
           yave=yave+y(i)
        enddo
        xave=xave/(4.*u)
        yave=yave/(4.*u)
!       print *,u
        x(4*u+1)=x(1)
        y(4*u+1)=y(1)
        call gr_exec('set ori 0')
        call gr4_give ('X',4*u+1,x) !to plot project borders
        call gr4_give ('Y',4*u+1,y)
        call gr_exec('pencil /dash 1 /weig 3')
!       habia weig 2 pero CT quiere mas gruesas para html
        if(prueba) call gr_exec('pencil /dash 1 /weig 1')
        call gr_exec('connect')
        call gr_exec('pencil /dash 1 /weig 2')
        if(prueba) call gr_exec('pencil /dash 1 /weig 1')
        no_b=0
        do i=1,15
           if(proje(i:i).eq.' ') no_b=no_b+1
        enddo
        no_bl = int(float(no_b)/2.)
        pr='  '
        pr(no_bl+1:15)=proje
        proje=pr
!       if(height.ge.1.2*width) then
        if(height.ge.1.3*width) then
           call gr_exec('set ori 90')
           z=height
           height=width
           width=z
           t=int(height)
           if(mod(no_b,2).ne.0) anga=.true.
        endif
        if(t.eq.1) then
                if(width.ge.4) then
                        call gr_exec('set exp 0.85')
                        if (ff) call gr_exec('set expand 0.63')

                else if(width.eq.3) then
                        call gr_exec('set exp 0.6')
                        if (ff) call gr_exec('set expand 0.45')

                else if(width.eq.2) then
                        call gr_exec('set exp 0.5')
                        if (ff) call gr_exec('set expand 0.385') !0.37 antes

                else
                        call gr_exec('set exp 0.43')
                        if (ff) call gr_exec('set expand 0.35') !antes 0.33

                endif
        else if(t.eq.2) then
                if(width.ge.4) then
                        call gr_exec('set exp 1.0')
                        if (ff) call gr_exec('set expand 0.75')

                else if(width.eq.3) then
                        call gr_exec('set exp 0.9')
                        if (ff) call gr_exec('set expand 0.67')

                else if(width.eq.2) then
                        call gr_exec('set exp 0.8')
                        if (ff) call gr_exec('set expand 0.6')

                else
                        call gr_exec('set exp 0.7')
                        if (ff) call gr_exec('set expand 0.55') !0.53 antes

                endif
        else if(t.eq.3) then
                if(width.ge.4) then
                        call gr_exec('set exp 1.1')
                        if (ff) call gr_exec('set expand 0.82')

                else if(width.eq.3) then
                        call gr_exec('set exp 0.8')
                        if (ff) call gr_exec('set expand 0.6')

                else if(width.eq.2) then
                        call gr_exec('set exp 0.7')
                        if (ff) call gr_exec('set expand 0.53')

                else
                        call gr_exec('set exp 0.6')
                        if (ff) call gr_exec('set expand 0.45')

                endif
        else
                if(width.ge.4) then
                        call gr_exec('set exp 1.2')
                        if (ff) call gr_exec('set expand 0.9')

                else if(width.eq.3) then
                        call gr_exec('set exp 1.1')
                        if (ff) call gr_exec('set expand 0.825')

                else if(width.eq.2) then
                        call gr_exec('set exp 1.0')
                        if (ff) call gr_exec('set expand 0.75')

                else
                        call gr_exec('set exp 0.9')
                        if (ff) call gr_exec('set expand 0.68')

                endif
        endif

        if(anga) then
!         xave = xave - 2 * corr
          xave = xave - 1 * corr
          yave = yave + 1.9 * 2 * corr
        endif
        if(mod(no_b,2).ne.0) xave = xave + corr
        write(chain,1015) xave,yave,proje
1015    format ('draw text',2(1x,f7.4),' " ',a15,' " 5 /USER')
        call gr_exec (chain)
        call gr_exec('pencil /dash 1 /weig 1')
        call gtclal  ! CLEAR ALPHA
        return
        end subroutine displ_proj

!***********************************************************************
! kw001
        subroutine gifcoor(proje,diap,tim_st,tim_end,s,t,diaa,cpolix,cpoliy)
        character  proje*15
        integer    i, j, s, p, u, t, diaa(16),a1,a2
        integer    diap(50,15)
        real       tim_st(50,15),tim_end(50,15)
        real       x(100), y(100), xave, yave, height, width
        real       centrox,centroy,ancho,alto
        real       xoff,yoff,deltax,deltay
        real       cpolix(100), cpoliy(100)
        data x     /100*0.0/
        data y     /100*0.0/
!c*************************************
!     para coordenadas esquina superior izda.
!     SB 08-apr-2011: values compatible with Greg older than january 2011
!       xoff=  64.0
!       yoff=  129.6
!       deltax=19.5
!       deltay=23.7
!
!      SB 08-apr-2011: values compatible with Greg equal or newer to january 2011
        xoff=  58.0
        yoff=  121.7
        deltax=17.8
        deltay=21.3
!
!     corrijo coordenadas al cambiar dev ps por eps
!     CT 17-Jun-04 adapt gif to the 3 day upshift of eps
!        xoff=xoff-11.75
!        yoff=yoff+38.0-3*deltay
!     back to ps 15-07-06 CT
        xoff=xoff
        yoff=yoff
!cccccccccccccccccccccccccccccccccccccc
        a1     = 0.0
        a2     = 0.0
        xave   = 0.0
        yave   = 0.0
        height = 0.0
        width  = 0.0
        ancho=0.0
        alto=0.0
        centrox=0.0
        centroy=0.0
        u=t

!        write(6,*) t,proje
!        pause

        do j=1,t
        p = j-1
          do i=1,16
            if(diap(s,j).eq.float(diaa(i))) then
                if(j.eq.1) a1=diaa(i)
                if(j.eq.t) a2=diaa(i)

                x(2*p+1) = (tim_st(s,j))*1
                x(2*p+2) = x(2*p+1)
                x(4*u-2*p-1) = (tim_end(s,j))*1
                x(4*u-2*p) = x(4*u-2*p-1)
                y(2*p+1) = (float(i)/1.)
                y(2*p+2) = (float((i+1))/1.)
                y(4*u-2*p-1) = y(2*p+2)
                y(4*u-2*p) = y(2*p+1)
                p = p+1
            endif
          enddo
          width=width+tim_end(s,j)-tim_st(s,j)
        enddo
        height=float(t)
        width=width/float(t)
        do i=1,4*u
           xave=xave+x(i)
           yave=yave+y(i)
        enddo
        xave=xave/(4.*u)
        yave=yave/(4.*u)

        centrox=xave
        centroy=yave-2.0
        ancho=width
        alto=height
!        ancho=6.0
!        alto=1.0
        ancho=ancho/2.0
        alto=alto/2.0

!c         coordenadas para poligono en vez de rectangulo

        do i=1,4*u
          cpolix(i)=xoff+deltax*x(i)
          cpoliy(i)=yoff+deltay*(y(i))
!         cpoliy(i)=yoff+deltay*(y(i)-2
        enddo
        return
        end subroutine gifcoor
!***********************************************************************
! kw002
        subroutine makehtml1(s,fichero,fichero2)
        character    fichero*20,fichero2*20
        integer      s

!        fichero2='test.gif'

        if(s.eq.1) open(unit=96,file=fichero,status='unknown')

!        write (96,1800)
!1800    format('<html>'/'<head>'/'<title>Imagen map test MR </title>')
!1800    format('<html>'/'<head>'/'<title>30m schedule MR </title>')
!        write (96,1801)
!1801    format('</head>'/'<body><center>')
        write (96,1802) fichero2
1802    format('<img src="',a10,' " usemap="#bwmap">')
!        write (96,1803)
!1803    format('</body>')

        write (96,1804)
1804    format('<map name="bwmap">')

        return
        end subroutine makehtml1
!***********************************************************************
! kw004
        subroutine makehtml2(s,fichero)
        character    fichero*20
        integer      s

!        write (96,1801)
!1801    format('</center>') !el center debe incluir el mapa

        write (96,1803)
1803    format('</map>')

!        write (96,1808)
!1808    format('</html>')

        return
        end subroutine makehtml2
!********************************************************************
! kw003
        subroutine  makemap(an,an2,s,fi,proyecto,v,cpolix,cpoliy,yy,mm)

        character(len=*), intent(in) :: fi(50)
        character    fii*20,proyecto(50)*15,bgyear*2
        character    aux*4,poolID*2
        character    href_dir*37
        character*60 text1,text2,text3,text4*50,ans*1
        integer      i,v,s,con_0,con_1,con_2,con_3,con_4,mm,yy,ww
        integer      yydir
        real         cpolix(100), cpoliy(100)
        logical      an, an2

        fii=fi(s)
!        fii='p114-99.html '  !para test
        con_0 = len_trim(fii)

!ccccccccccc elegir opcion cccccccccccccccccccccccccccccccccccc

!        text1='#" onclick="window.open('''
!        text1='#" onmouseout="window.open('''
!        text1='#" onmouseover="window.open('''
!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

!        text2=fii(1:con_0)//',''mr'',''height=200,'
!        text2=fii(1:con_0)//',''height=200,'
!        text3='width=200,top=200,left=500'');">'
!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

        text1=fii(1:con_0)//'">'
        text2=' '
        text3=' '

        con_1 = len_trim(text1)
        con_2 = len_trim(text2)
        con_3 = len_trim(text3)

!        text4=text1(1:con_1)//text2(1:con_2)//text3(1:con_3)
        text4=text1(1:con_1)

        write (96,1805) cpolix(1),cpoliy(1)
1805    format('<area shape="poly" coords="',f5.1,',',f5.1)

        do i=2,4*v-1
         write (96,1806) cpolix(i),cpoliy(i)
1806     format(' ',2(',',f5.1))
        enddo

!       special case: the first schedule of next year starts already in Dec
        if (fii(2:3).eq.'00'.and.mm.eq.12) then
           yydir = yy + 1
        else
           yydir = yy
        endif
        write(aux,'(i4)') yydir
        bgyear = aux(3:4)
        read(fii(2:3),'(i2)') ww
!        print *, 'yy= ', yy
!        print *, 'aux:',aux,' yydir= ',yydir,' bgyear:',bgyear

        poolID = text4(5:6)
        href_dir= 'bgfiles/'//bgyear//'/'
!       here poolID represents the first 2 digit of the pool project ID (as defined in the .dat file)
!       for summer semester 400-yy and 300-yy are for heterodyne and bolometer pool, respectively
!       for winter semester 440-yy and 330-yy are for heterodyne and bolometer pool, respectively
!        if (poolID.eq.'30'.or.poolID.eq.'33') then
!           text4 = 'bolopool.html">'
!        elseif (poolID.eq.'40'.or.poolID.eq.'44') then
!           text4 = 'hetepool.html">'
!        endif
!         if (poolID.eq.'30') then
!            text4 = 'bolopool-S11.html">'
!         elseif (poolID.eq.'33') then
!            text4 = 'bolopool-W11.html">'
!         elseif (poolID.eq.'40') then
!            text4 = 'hetepool-S11.html">'
!         elseif (poolID.eq.'44') then
!            text4 = 'hetepool-W11.html">'
!         endif
        con_4 = len_trim(text4)

!        print *, href_dir, text4, poolID
        write (96,1807) cpolix(4*v),cpoliy(4*v),trim(href_dir),trim(text4)
!1807    format(' ,',f5.1,',',f5.1,'" href="',a20)             !CT 24-Jun-04
!1807    format(' ,',f5.1,',',f5.1,
!     1             '" href="../../../../php/schedule/html',a20)    !CT 04-feb-2005
1807    format(' ,',f5.1,',',f5.1,'" href="',a,a)

        if (an) then
!          these files are not used anymore (CT Jan 2005)
!          individual project files are now written by DB
!          open (97,file=fii,status='unknown')
!          close(97,status='delete') !hay que borrar antes de crear otra
!          open (unit=97,file=fii,status='unknown')

!c         files html for each project

          write (97,1820)
1820      format('<html>'/'<head>'/'<title> schedule </title>')
          write (97,1821)
1821      format('</head>'/'<body>')
!          print*, proyecto(s)(4:6), fii
!          pause
          if(proyecto(s)(4:6).eq.char(92)//'gD') then
            proyecto(s)='d'//proyecto(s)(7:15)
!          endif
!          print*, proyecto(s), fii
!          pause
          endif
!          write (97,1831)
1831      format('<p> ')
          write (97,1822) proyecto(s)
1822      format('project: ',a20)
          write (97,1831)
          write (97,1823)
1823      format('PC letter: ')
          write (97,1831)
          write (97,1824)
1824      format('Observer: ')
          write (97,1831)
          write (97,1825)
1825      format('Observing mode:  PV/service/remote')
          write (97,1831)
          write (97,1833)
1833      format('</body>')
          close (unit=97)
        endif
!       option to create only some of the html files
        if(an2) then
          write(6,'(1x,a,$)') 'create ',fii(1:con_0),' (y/n)? > '
          read (5,'(a1)') ans
          if (ans.eq.' ') ans = 'n'
            if((ans.eq.'y').or.(ans.eq.'Y')) then
                open (97,file=fii,status='unknown')
                close(97,status='delete') !hay que borrar antes de crear otra
                open (unit=97,file=fii,status='unknown')
                write (97,1820)
                write (97,1821)

          if(proyecto(s)(4:6).eq.char(92)//'gD') then
            proyecto(s)='d'//proyecto(s)(7:15)
!          endif
!          print*, proyecto(s), fii
!          pause
          endif
                write (97,1822) proyecto(s)
                write (97,1831)
                write (97,1823)
                write (97,1831)
                write (97,1824)
                write (97,1831)
                write (97,1825)
                write (97,1831)
                write (97,1833)

                close (unit=97)
            endif
          endif
        return
        end subroutine makemap
!***********************************************************************

        subroutine hsidnew(ye,mo,da,sid_ho,sid_min,lon_de,lon_mi,lon_se,lsummer)

        integer*4 ye,mo,da,ho,mi,ho0,mi0,sid_ho,sid_min,k
        real*4 lon_de,lon_mi,lon_se,aa,x1,x2,x4,y1,y2,y3,y4
        real*8 dt,hs0,sec,sidtime,sidtime0,factor,sec1
        character chain*80,csid_ho*4
        logical   lsummer

        k=1
        if (mo.le.2) k=0
        aa=ye+k-1
        factor=0.997268519     ! 3m56s less every day

! *** CALCULATING NUMBER OF DAYS :
        dt=float((ye-1)*365-723910+int(aa/4.)-int(aa/100.)  &
           +int(aa/400.)+(mo-1)*31+da-1-k*int(.4*float(mo)+2.3))+1.0
!c      !+1.0day works better MR
!
! *** SIDEREAL TIME :
        hs0=.27800846065+1.002737909315*dt+((lon_se/60.+lon_mi)/60.+  &
            lon_de)/360.0

        hs0= dmod(hs0,1.0d0)*24.
        if (hs0.lt.0.) hs0=hs0+24.      ! sid time at 00:00 UT

        sidtime0=24.0-hs0*factor        ! UT at 00:00 sid time
        sec=sidtime0
        ho0=int(sec)                    ! HOURS
        sec=(sec-int(sec))*60.
        mi0=int(sec)                    ! MINUTES

        sidtime=sidtime0+(sid_ho+sid_min/60.)*factor ! UT at si.d time asked
!        CT: don't draw outside of the box
        if (sidtime.lt.0.) sidtime=sidtime+24.
        if (sidtime.gt.23.) sidtime=sidtime-24.+0.0655555    !
!       if (sidtime.lt.0.8) sidtime=sidtime+24.
!       if (sidtime.gt.23.2) sidtime=sidtime-24.+0.0655555
!cc     0.06555 is +3m56s =+1day
        sec1=sidtime
        sec=sidtime
        ho=int(sec)                     ! SIDEREAL HOURS
        sec=(sec-int(sec))*60.
        mi=int(sec)                     ! SIDEREAL MINUTES

        y1=0.888888
        y2=0.058
        y3=0.037
        write(csid_ho,'(i2.2,a)')   sid_ho,' h'

        call gr_exec('pencil /dash 2 /weig 1')
!       x1=0.095+0.037083*sec1
!       x2=0.095+0.037083*(sec1-1)
        if (lsummer) then
         x1=0.095+0.037083*(sec1+2)
         x2=0.095+0.037083*(sec1+1)
        else
         x1=0.095+0.037083*(sec1+1)
         x2=0.095+0.037083*(sec1+0)
        endif
        if (x1.le.0.115) then      !LST line goes left of UT 0 h
            x4 = 0.096
            y4 = 0.5*(y1-y2)
            write (chain,2225) x1,y1
            call gr_exec (chain)
            write (chain,2226) x4,y4
            call gr_exec (chain)
            x1 = 0.9836
            y1 = y4
            x4 = x1-0.0185
            y4 = y2
            write (chain,2225) x1,y1
            call gr_exec (chain)
            write (chain,2226) x4,y4
            call gr_exec (chain)
            call gr_exec('pencil  /dash 1 /weig 1')
            write (chain,2227) x4,y3,csid_ho
            call gr_exec (chain)
            goto 2230
         else                           !LST lines fully within UT frame
            write (chain,2225) x1,y1
            call gr_exec (chain)
            write (chain,2226) x2,y2
            call gr_exec (chain)
            call gr_exec('pencil  /dash 1 /weig 1')
            write (chain,2227) x2,y3,csid_ho
            call gr_exec (chain)
        endif

2227    format ('draw text',2(1x,f7.4),' " ',a4,'" 5 /USER /CLIP')
2226    format ('draw lin',2(1x,f7.4),' /CLIP')
2225    format ('draw relo',2(1x,f7.4))

2230    continue
        return
        end subroutine hsidnew

!***********************************************************************

        subroutine rx_mark(n,m)    ! (dia=n; receptor=m) MR FEB-91

        integer    n,m
        real       a1,b1,ia,ib,x,y
        character  chain*80

325     format ('draw mark',2(1x,f8.6),' 5 /USER')

        a1=0.814668                             ! origin x
        b1=0.91745                              ! origin y
        ia=0.028518                             ! x increment
        ib=0.05555                              ! y increment

        x=a1+m*ia
        y=b1-n*ib
        write(chain,325) x,y
        call gr_exec (chain)
        return
        end subroutine rx_mark

!       program test
!       program possol
!       integer*4   aano,ames,adia
!       real*8      horasal,horapues
!       aano=1999
!       ames=8
!       adia=1
!       call sunposi (aano,ames,adia,horasal,horapues)
!       print*, 'hora UTC salida del sol= ',horasal
!       print*, 'hora UTC puesta del sol= ',horapues
!       print*, 'del dia = ',adia,ames,aano
!       end
!
!******************POSITION OF THE SUN ****************
        subroutine sunpos (tim1,tim2,tim3,salida,puesta)
!
        integer         time(7)
        integer         tim1,tim2,tim3
        integer         ig,imi,is,iy,im,id,idt,jj
        real*8          ra,de,frday,alst,dt,gst,lst
        real*8          ajd,al_s,elev,azim,errpos,alat,sila,cola,ha
        real*8          eps,pi,ome,e,err,d,ei,am_a,t_a
        real            salida,puesta
! *** parameters :
        pi = 3.14159265359
        eps = 278.833540/180.*pi        ! ecliptic longitude at epoch 1980.0
        ome = 282.596403/180.*pi        ! ecliptic longitude of perigee
        e = 0.016718                    ! eccentricity of orbit
        errpos = 0.25                   ! error allowed in elev
!
        time(1)= tim1           ! year
        time(2)= tim2           ! month
        time(3)= tim3           ! day
        time(4)= 0              ! hour UTC
        time(5)= 0              ! min
        time(6)= 0              ! sec
        time(7)= 0              ! tenth of sec.
! *** getting days since year 1, month 1 and day 1 :
        iy=time(1)
        im=time(2)
        id=time(3)
!       do i =1,7
!         print*,i,time(i),iy,im,id
!       end do
!********************************************
!***********loop to get elev zero************
!********************************************
        call ditra (iy,im,id,idt,ajd) !dias transcurridos
        DO jj= 240,1440 !1440 !  1440min/day=24h*60min/h
!        frday=float(jj/1440.)
        frday=jj/1440.
        dt=float(idt)+frday
!       print*,'fraccion de dia transcurrida : ',frday
!       do i =1,7
!         print*,i,time(i),iy,im,id
!       end do
!       print*,'total dias transcurridos : ',dt,idt
!
!
! *** getting sidereal time :
!       dt=dt-1./24.            ! because computer time
        call getst (dt,gst,lst) ! funciona bien el tiempo sidereo
!       print*,'lst = ',lst
        alst=lst*2.*pi
        call cgms (alst,ig,imi,is,3)
!       print*,'lst = ',lst
!       print*,'doble. time : ',iy,im,id,2*iy,2*im,2*id
!       pause

! *** getting ecliptic coordinates :
!       print*,'total dias transcurridos : ',dt
        de=dt-722813.
        d=de
!       print*,de,d
        am_a = mod((2.*pi/365.2422*d+eps-ome),(2.*pi))  ! mean anomaly
        ei = am_a                                       ! eccentric anomaly
        err=1.
        do while (err.gt.1.e-10)
         err = ei-e*sin(ei)-am_a
         de = err/(1.-e*cos(ei))
         ei = ei-de
        end do
        t_a = 2.*atan(sqrt((1.+e)/(1.-e))*tan(ei/2.))   ! true anomaly
        al_s = mod((t_a+ome),(2.*pi))                   ! longitude of the sun
!

! *** getting equatorial coordinates :
        call eecc (al_s,0.d0,ra,de)       ! right ascension and declination
        call cgms (ra,ig,imi,is,3)
!       print*,'ra => ',ra,ig,imi,is
        call cgms (de,ig,imi,is,2)
!       print*,'de => ',de,ig,imi,is
!
!
! *** getting horizon coordinates :
        alat=.646962526         ! 30m radiot. latitude (37deg. 4' 5.6")
        sila=sin(alat)
        cola=cos(alat)
        ha=lst*2.*pi-ra                 ! hour angle (radians)
!       print*,'hour angle = ',ha
        elev=asin(sin(de)*sila+cos(de)*cola*cos(ha))
        azim=acos((sin(de)-sila*sin(elev))/(cola*cos(elev)))
        if ((sin(ha)).gt.0.) azim=2.*pi-azim
!       print*,'az and el = ',azim,elev
        call cgms (azim,ig,imi,is,1)
!       print*,'azimuth = ',azim,ig,imi,is
        call cgms (elev,ig,imi,is,1)
!       print*,'elevat. = ',elev,ig,imi,is
        azim=azim/pi*180.
        elev=elev/pi*180.
!       print*, azim
!       print*, elev
        if((-errpos.le.elev).and.(elev.le.errpos)) then
!          print*, 'az,el',jj,azim,elev,frday,idt
           if((240.le.jj).and.(jj.le.540))   salida=24.*frday
           if((960.le.jj).and.(jj.le.1440))  puesta=24.*frday
        end if
        END DO
!       print*,'jj,fracc de dia ,elev= ', jj,frday,elev
!       end do
        return ! end sunpos
        end subroutine sunpos
!c
        subroutine eecc (elo,ela,ra,de)
!   subroutine to make the ecliptic to equatorial coordinate conversion
!   elo = ecliptic longitude (radians)
!   ela = ecliptic latitude (radians)
!   ra = riht ascension (radians)
!   de = declination (radians)
        real*8 elo,ela,ra,de,pi,ep
        real*8 anum,den
        pi = 3.14159265359
        ep=23.441884/180.*pi    ! obliquity of the ecliptic
!
! *** calculation of the right ascension ra:
        anum=sin(elo)*cos(ep)-tan(ela)*sin(ep)
        den=cos(elo)
        ra=atan(anum/den)
        if (den.lt.0.) ra=ra+pi
        ra=mod(ra,(2.*pi))
!
! *** calculation of the declination de:
        de=asin(sin(ela)*cos(ep)+cos(ela)*sin(ep)*sin(elo))
        de=mod(de,(2*pi))
        return
        end subroutine eecc
!
!
        subroutine cgms (angi,gra,min,sec,k)
!   subroutine to make the conversion of the angle ang with the following
!   options:
!   k=1, 0 <= output angle < 360
!   k=2, -180 < output angle <= 180
!   k=3, 0 h <= output angle < 24 h
        integer gra,sec,min,k
        real*8  pi,ang,angi,amin
        pi = 3.14159265359
        ang=angi*180./pi
        ang=mod(ang,360.d00)
        if ((k.eq.3).and.(ang.lt.0.)) ang=ang+360.
        if (k.eq.2.and.ang.gt.180.) ang=ang-360.
        if (k.eq.3) ang=ang/15.
        gra=int(ang)
        amin=60.*(ang-float(gra))
        min=int(amin)
        sec=nint(60.*(amin-float(min)))
        return
        end subroutine cgms
!
!
        subroutine ditra (an,me,di,dt,jd)
!
!   subrutina para calcular los dias transcurridos desde el comienzo de nuestra
!   era. ano 1, mes 1 y dia 1 dara 0 dias transcurridos.
!
!       an = ano                        (input integer*4)
!       me = mes                        (input integer*4)
!       di = dia                        (input integer*4)
!       dt = dias transcurridos         (output integer*4)
!       jd = julian date                (output real*4)
!
        integer         k,ab,an,me,di,dt
        real*8          jd
!
        k=1
        if (me.le.2) k=0
        ab=an+k-1
        dt=(an-1)*365+int(ab/4.)-int(ab/100.)+int(ab/400.)  &
           +(me-1)*31+di-1-k*int(.4*float(me)+2.3)
        jd=float(dt)+1721425.5
        return
        end subroutine ditra
!
!
        subroutine getst (dt,gst,lst)
!
!   subrutina para obtener gst (greenwich sidereal time) y lst (local sidereal
!   time) conociendo los dt (dias transcurridos) desde el comienzo de nuestra
!   era.
!
!       dt  = dias transcurridos desde comienzo era     (input real*8)
!       gst = greenwich sidereal time (fraction of day) (output real*8)
!       lst = loca sidereal time at 30m radiotelescope  (output real*8)
!
        real*8  dt,gst,lst,dtb
!
        dtb=dt-723910.          ! dias transcurridos desde comienzo 1983
        gst=.27800846065+1.002737909315*dtb
        if (gst.lt.0.) gst=gst-int(gst)+1.
        gst=gst-int(gst)
        lst=gst-0.009442978     ! local sidereal time
        return
        end subroutine getst
!
subroutine parse_file_name(file,basename,wk,vers,error)
  !---------------------------------------------------------------------
  ! @ private
  ! Decode the file version from file name. File name must have the form
  !   wk12v3.dat  (1 or more digits for the version).
  ! Return version as an integer
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: file      !
  character(len=*), intent(out)   :: basename  !
  integer(kind=4),  intent(out)   :: wk        ! Week number
  integer(kind=4),  intent(out)   :: vers      ! Version
  logical,          intent(inout) :: error     !
  ! Local
  integer :: vpos,dpos,ier
  !
  vpos = index(file,'v')+1
  dpos = index(file,'.')-1
  basename = file(1:dpos)
  !
  read(file(3:4),*,iostat=ier)  wk
  if (ier.ne.0) then
    write(6,*) 'Error getting week number from file name '//trim(file)
    error = .true.
    return
  endif
  !
  read(file(vpos:dpos),*,iostat=ier)  vers
  if (ier.ne.0) then
    write(6,*) 'Error getting version from file name '//trim(file)
    error = .true.
    return
  endif
  !
end subroutine parse_file_name
