source: trunk/LMDZ.MARS/libf/bibio/mywrite.F @ 300

      SUBROUTINE mywrite(champ,icount,titre,unit,format,nom
     &                  , entete, date0, date, deltpas, nbeta
     &                  , deltajour, filenum, files)
C----------------------------------------------------------
C Subroutine qui ecrit les fichiers dans le format de transfert
C vers le LMD.
C format etabli par Zhao-Xin Li, Frederique Hourdin, Emmanuelle Cohen-Solal,
C Jan Polcher . Il peut etre utilise pour sortire  des evolutions
C temporelles, des champs 2D (iim,jjm ou jjm,llm) ou des champs 3D.
C le character # place devant le format determine la fin de la 
C description du champ et permet eventulellement de rajouter
C des informations (avant le #).
C le programme de lecture lit , dans la description, les variables
C qu'il connait et saute apres jusquau #. A partir de la
C il commence a lire le champ dans le format specifie.
c------------------------------------------------------------
C       ARGUMENTS
C       +++++++++
C champ: REAL (icount)
C        champ contenant les valeurs et de longeur icount
C icount: INTEGER
C         nombre d'element dans le champ
C titre: CHARACTER*100
C        nom d'ecrivant le champ
C unit: CHARACTER*20
C       unites du champ
C format: CHARACTER*20
C         format dans le quel le champ doit etre ecrit.
C         au choix:
C                  - tous les format FORTRAN
C                  - compactage de L.Li (zxliN) ou N peut valoir 1, 2 ou 3
C nom: CHARACTER*20
C      nom du fichier dans le quel le champ sera ecris, eventuellement
C      avec directory (ex: evol/tsol)
C entete: CHARACTER*100
C         une entete du fichier pouvant par exemple decrire le run
C date0: CHARACTER*8
C        date de depart de la moyenne ou de l'evolution temporelle que contient
C        le fichier
C date : CHARACTER*8
C        date de fin de la moyenne ou de l'evolution temporelle que contient
C        le fichier
C deltpas: INTEGER (bandmax)
C          decript le nombre de pas de temps entre deux sorties pour chamque
C          bande (necesaire pour les evolutions temporelles)
C nbeta: INTEGER (bandmax)
C        donne le nombre d'etas par bande (necesaire pour les evolutions 
C        temporelles)
C deltajour: REAL (bandmax)
C             l'ecart en jours des iscriptions sur chaque bande (necesaire 
C             pour les evolutions temporelles)
C filenum: INTEGER
C          nombre d'elements dans la liste files des champs desires
C          si filenum = 0 alors tous les champs sont sortis  
C files: CHARACTER*20 (100)
C        list des champ que l'on desire sortire
C
C        PARAMETER
C        +++++++++
C bandmax: INTEGER
C          le nombre maximale que peut traiter le programme
C


      IMPLICIT NONE

      INTEGER bandmax
      PARAMETER (bandmax = 24)
      INTEGER icount,i,imin,imax
      REAL champ(icount)
      CHARACTER*100 titre, entete
      CHARACTER unit*20,nom*80
      CHARACTER*20 format
      CHARACTER*8 date0, date
      INTEGER deltpas(bandmax), nbeta(bandmax)
      REAL deltajour(bandmax)
      LOGICAL check, writeornot
      INTEGER lnblnk,ismin,ismax
      INTEGER filenum
      CHARACTER*20 files(100)
      EXTERNAL lnblnk,ismin,ismax, isitor, to36

      check = .FALSE.

      IF (filenum .EQ. 0) THEN
        writeornot = .TRUE.
      ELSE
        CALL isitor(nom,writeornot,filenum, files)
      ENDIF

      IF (check) THEN
        WRITE(*,*) 'MYWRITE:: writeornot=',writeornot
      ENDIF

      IF (writeornot) THEN
      imin = ismin(icount,champ,1)
      imax = ismax(icount,champ,1)
      IF (check) THEN
        WRITE(*,*) entete(1:lnblnk(entete))
        WRITE(*,*) titre(1:lnblnk(titre))
        WRITE(*,*) date0
        WRITE(*,*) date
        WRITE(*,*) unit(1:lnblnk(unit))
        WRITE(*,*) deltpas, nbeta
        WRITE(*,*) deltajour
        WRITE(*,*) champ(imin),champ(imax)
        WRITE(*,*) format(1:lnblnk(format))
        WRITE(*,*) icount
      ENDIF
      WRITE(*,*) titre(1:lnblnk(titre)),'min,max:',
     &           champ(imin),champ(imax),'  ',unit(1:lnblnk(unit))
      
      OPEN (unit=55, file=nom(1:lnblnk(nom)))
      WRITE(55,'(a)') entete(1:lnblnk(entete))
      WRITE(55,'(a)') titre(1:lnblnk(titre))
      WRITE(55,'(a)') date0
      WRITE(55,'(a)') date
      WRITE(55,'(a)') unit(1:lnblnk(unit))
      WRITE(55,*) deltpas, nbeta
      WRITE(55,*) deltajour
      WRITE(55,*) champ(imin),champ(imax)
      WRITE(55,'(a)') '#'//format(1:lnblnk(format))
      WRITE(55,*) icount

      IF (check) THEN
        WRITE(*,'('//format(1:lnblnk(format))//')') champ(1)
      ENDIF

      IF (format(1:lnblnk(format)) .EQ. 'zxli1') THEN
        CALL to36 (champ,icount,champ(imin),champ(imax),55, 1)
      ELSE 
        IF (format(1:lnblnk(format)) .EQ. 'zxli2') THEN
          CALL to36 (champ, icount,champ(imin), champ(imax),55, 2)
        ELSE
          IF (format(1:lnblnk(format)) .EQ. 'zxli3') THEN
            CALL to36 (champ,icount,champ(imin),champ(imax),55, 3)
          ELSE
            DO 2233 i=1,icount
              WRITE(55,'('//format(1:lnblnk(format))//')') 
     &             champ(i)
 2233       CONTINUE
          ENDIF
        ENDIF
      ENDIF

      CLOSE (unit=55)

      ELSE
        WRITE(*,*) 'FILE    ',nom,'WAS NOT WRITEN'
      ENDIF
      
      RETURN
      END