c
c     XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX0XX
c
c     Modules commun a toutes les animations de magnetospheres
c
c     P. Robert, CETP, 1996, revu et mis en bibli Juin 2003
c
c     XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX0XX
c
      subroutine rap_qualimage(iresx, iresy,isizx, isizy,tranx, trany) 
c
c *** lecture et print de la resolution en ppi (pts per inch)
c     pour le grand png, de la taille de l'image finale (en pts),
c     et de l'offset pour le recadrage des .ps avant conversion en png.
c
c     valeurs standards:
c
c     iresx, iresy / 150, 150/
c     isizx, isizy / 768, 576/
c     tranx, trany /2.45, 5.92/
c
      print*, 'resolution du .ps a convertir en png ? (ex: 150 dpi)'
      read *, iresx,iresy
      print*, iresx,iresy
c
      print*, 'taille pour le png ? (ex: 768 576 comme une image PAL)'
      read *, isizx,isizy
      print*, isizx,isizy
c
      print*, 'decalage x et y de l''origine du .ps pour cadrage ? ',
     &        '(ex: 2.45, 5.92 cm)'
      read *, tranx,trany
      print*, tranx,trany
c
      return
      end
c
c     XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX0XX
c
      subroutine calch3(ival,ch3)
c
c     *****************************************************************
c     encode un nombre (0-999) dans un character*3 sans blancs
c     *****************************************************************

      character*3 ch3

                     write(ch3,103) abs(ival)
      if(ival.le.99) write(ch3,102) abs(ival)
      if(ival.le.9)  write(ch3,101) abs(ival)

  101 format('00',i1)
  102 format('0' ,i2)
  103 format(     i3)

      return
      end

c     XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX0XX

      subroutine change_scr(ic,filbat)
c
      character*(*) filbat
c
c *** creation du fichier change_scr.bat
c
      close(ic)
      open (ic, file=filbat, status='unknown')
c
      write(ic,100) '#!/bin/sh'
      write(ic,100)
      write(ic,100) '# ',('X',i=1,70)
      write(ic,100) '# fichier cree par animagneto.bat'
      write(ic,100) '# permet la modification des fichires animag.cyc'
      write(ic,100) '# et animag.scr pour rajouter le path complet'
      write(ic,100) '# '
      write(ic,100) '# P. Robert, CETP, 1996'
      write(ic,100) '# ',('X',i=1,70)
      write(ic,100)
      write(ic,100) 'wdi=`pwd`'
      write(ic,100)
      write(ic,100) '# modif des fichiers animag.cyc et animag.src'
      write(ic,100)
      write(ic,100) 'cp animag.cyc animag.tmp'
      write(ic,100) 'sed "s!resu_x!$wdi/resu_x!" animag.tmp >animag.cyc'
      write(ic,100) 'rm animag.tmp'
      write(ic,100)
      write(ic,100) 'cp animag.scr animag.tmp'
      write(ic,100) 'sed "s!resu_x!$wdi/resu_x!" animag.tmp >animag.scr'
      write(ic,100) 'rm animag.tmp'
      write(ic,100) '# ',('-',i=1,70)
c
      close(ic)
c
  100 format(80a)
c
      return
      end
c
c     XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX0XX
c
      subroutine wheader_scr(ic,filscr)
c
      character*(*) filscr
c
c *** ecriture de l'entete du fichier .scr ou .cyc
c
      close(ic)
      open (ic, file=filscr, status='unknown')
c
      write(ic,100) '# ',('-',i=1,70)
c
      write(ic,100) '  image_create_scene 400 200 910 680'
      write(ic,100) '  image_set_color      0.  0.  0.   '
      write(ic,100) '# ',('-',i=1,70)
c
  100 format(80a)
c
      return
      end
c
c     XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX0XX
c
      subroutine wheader_ps_to_png(ic,filbat)
c
      character*(*) filbat
c
c *** ecriture de l'entete du fichier de conversion all_ps_to_png.bat
c
      close(ic)
      open (ic, file=filbat, status='unknown')
c
      write(ic,100) '#!/bin/sh'
      write(ic,100)
      write(ic,100) '# ',('X',i=1,70)
      write(ic,100) '# fichier cree par animagneto.bat'
      write(ic,100) '# permet la conversion des fichiers .ps en .png'
      write(ic,100) '# et extrait et recentre une partie du gros .png'
      write(ic,100) '# '
      write(ic,100) '# P. Robert, CETP, 1996'
      write(ic,100) '# ',('X',i=1,70)
      write(ic,100)
      write(ic,100) 'libdir=.'
      write(ic,100)
      write(ic,100) '# transformation en boucle des fichiers ps en png'
      write(ic,100) '# '
      write(ic,100) '# ',('-',i=1,70)
c
  100 format(80a)
c
      return
      end
c
c     XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX0XX
c
      subroutine fill_ps_to_png(ic,fileps,filpng,
     &                          iresx,iresy,isizx,isizy)
c
      character*(*) fileps,filpng
c
c *** remplissage du fichier de conversion all_ps_to_png.bat
c
      write(ic,100)
      write(ic,100) 'if test -f ',fileps
      write(ic,100) 'then'
      write(ic,100) 'echo "conversion of ',fileps,' to ',filpng,' ..."'
      write(ic,200) '$libdir/ps_to_png_xy.sh ',iresx,iresy,isizx,isizy,
     &              ' < ',fileps,' > ',filpng
      write(ic,100) 'else'
      write(ic,100) 'echo "No ',fileps,' to convert into .png"'
      write(ic,100) 'fi'
c
  100 format(80a)
  200 format(a,4i7,4a)
c
      return
      end
c
c     XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX0XX
c
      subroutine fill_cyc(ic,itime,nbp,filavs)
c
      character*(*) filavs
c
c *** remplissage des fichiers d'animation .cyc et .scr pour AVS
c
      if(itime.eq.1) then

      write(ic,100) '  image_read_image      -image "animag" ',filavs
      write(ic,100) '  image_set_visibility  -image "animag" 1'
      write(ic,100) '  image_cycle_store     -image "animag" 1'
      write(ic,100) '  image_cycle_speed     -image "animag" 0'
      write(ic,100) '# ',('-',i=1,70)
c
                     else
      write(ic,100) '  image_cycle_read_data ',filavs
                     endif
c
      if(itime.eq.nbp) write(ic,100) '# ',('-',i=1,70)
c
  100 format(80a)
c
      return
      end
c
c     XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX0XX
c
      subroutine fill_scr(ic,itime,nbp,filavs,ch3,ch3p)
c
      character*(*) filavs,ch3,ch3p
c
c *** remplissage des fichiers d'animation .cyc et .scr pour AVS
c
      if(itime.eq.1) then
      write(ic,100) '  image_read_image   -image amag_',ch3,' ',filavs
c
                     else
      write(ic,100) '  image_read_image   -image amag_',ch3,' ',filavs
      write(ic,100) '  image_delete_image -image amag_',ch3p
                     endif
c
      if(itime.eq.nbp) write(ic,100) '# ',('-',i=1,70)
c
  100 format(80a)
c
      return
      end
c
c     XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX0XX
c
      subroutine corr_date(dech,idoty1,iyear,idoty)
c
c *** correction de l'annee et du jour de l'annee si idoty
c     depasse le nb de jour de l'annee courante
c
      nbjou=int(dech/24.)
      idoty=idoty1+nbjou
      dech=dech-24.*nbjou 
c
      call coleapy(iyear,ily)
      if(idoty.gt.365+ily) then
                           iyear=iyear+1
                           idoty=idoty-365-ily
                           endif
c
      return
      end
c
c     XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX0XX
c
      subroutine co_caption(iy,imon,iday,ih,im,is,ex,ikp,ckp,rep,com,nc)
c
c *** calcul en mode caracter la legende a rajouter sur la vue
c
      character*(*) ex,rep,com,ckp
      character*9 cmon,ctime
      character*6 mod
c
c
      call cmoncar_(imon,cmon)
      call ctimcha_(ih,im,is,ctime)
      call cchalen_(cmon,ncmon)
c
      mod=ex
      call upper_case(mod,1)
      call longut(mod,nc)
c
      write(com,200) cmon(1:ncmon),iday,iy,ctime(1:5),mod(1:nc),ikp,
     &               ckp,rep
  200 format(a,i3,',',i5,' - ',a,1x,a,', K',i1,' Kp ',a2,', ',a)
c
      call cchalen_(com,nc)
c
      return
      end
c
c     XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX0XX
c
      subroutine plo_caption(com,nc,ch3,labo,icdat1,icdat2,icdat3,
     &                  icnum1,icnum2,icnum3,iccet1,iccet2,iccet3)
c
      character*(*) com,ch3,labo
c
c *** plot des legendes sur l'image
c
      call dlinihsb(icdat1,icdat2,icdat3)
      call pfigcha_(-15.7  , 13.5 ,-1,0.33,0.33,0.,com(1:nc))
c
      call dlinihsb(icnum1,icnum2,icnum3)
      call pfigcha_( 20.0  , 13.5 ,-1,0.38,0.38,0.,ch3)
c
      call dlinihsb(iccet1,iccet2,iccet3)
      call pfigcha_( 20.0  ,-13.7 ,-1,0.60,0.60,0.,labo)
c
      return
      end
c
c     XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX0XX
c
c      subroutine co_plot_flow(gdx,gdz,sunpo,zmin,zmax,ts,itime,istep,np)
cc
cc     -----------------------------------------------------------------
cc *** calcule et plot le vent solaire
cc
cc     P. Robert, CETP, juin 2003
cc     -----------------------------------------------------------------
cc
c      character*(*) sunpo
c      character*1 col
c      dimension xflow(1000),zflow(1000)
cc
c      if(np.gt.1000) stop 'co_plot_flow: np >1000'
cc
c      call coflow(gdx,gdz,xflow,zflow,np)
c      call glincol_(col)
c      call dlincol_('y')
cc
c      ideb=MOD(itime,istep) +1
cc
c      if(sunpo(1:1).eq.'l') then
c                            i1=np-ideb
c                            i2=1
c                            i3= -istep
c                            else
c                            i1=ideb
c                            i2=np
c                            i3=istep
c                            endif
cc
c      do 10 i= i1,i2,i3
c      if(sunpo(1:1).eq.'l') xflow(i)= -xflow(i)
c      if(zflow(i).ge.zmax.or.zflow(i).le.zmin) go to 10
cc
c      call pfigsym_(xflow(i),zflow(i),0,ts,ts,'circ')
c      call pfilzon_
c   10 continue
cc
c      call dlincol_(col)
cc
c      return
c      end
c
c     XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX0XX
c
      subroutine longut(mot,nc)

      character mot*(*)
 
c     *****************************************************************
c     calcul de la longueur utile
c     *****************************************************************
 
      nbc=len(mot)
 
      do 10 i=1,nbc
      ii=nbc-i+1
      if(mot(ii:ii).ne." ") go to 12
   10 continue
      ii=0
   12 continue
      nc=ii

      return
      end
c
c     XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX0XX
c
