c================================================================= *=*=*=*= writedrsfi.html =*=*=*=*
subroutine writedrsfi

subroutine writedrsfi


      subroutine writedrsfi(ngrid,unit,nom,titre,unite,dim,px)

c=================================================================
c
c  Francois Forget 05/94
c
c  Ecriture de variables diagnostiques au choix dans la physique
c  dans un fichier drs nomme  'diagfi'. Ces variables peuvent etre
c  3d (ex : temperature), 2d (ex : temperature de surface), ou
c  0d (pour un scalaire qui ne depend que du temps : ex : la longitude
c  solaire)
c  la periode d'ecriture est la meme que pour les variables de controle
c  mais cela peut etre change facilement vers la ligne 90
c
c    writedrsfi peut etre appele de n'importe quelle subroutine
c    de la physique, plusieurs fois. L'initialisation et la creation du
c    fichier se fait au tout premier appel.
c
c WARNING : les variables dynamique sauvees par writedrsfi avec une
c date donnee sont differentes que dans histoire car
c on ne leur a pas encore ajoute les tendances physiques et de la
c  dissipation !!!
c
c
c  parametres (input) :
c  ----------
c      ngrid : nombres de point ou est calcule la physique
c                (ngrid = 2+(jjm-1)*iim - 1/jjm)
c                 (= nlon ou klon dans la physique terrestre)
c
c      unit : unite logique du fichier de sortie (toujours la meme)
c      nom  : nom de la variable a sortir (chaine de caracteres)
c      titre: titre de la variable (chaine de caracteres)
c      unite : unite de la variable (chaine de caracteres)
c      px : variable a sortir (real 0, 2, ou 3d)
c      dim : dimension de px : 0, 2, ou 3 dimensions
c
c=================================================================

      implicit none
#include "dimensions.h"
#include "dimphys.h"
#include "paramet.h"
#include "control.h"
#include "comvert.h"
#include "comgeom.h"
#include "description.h"
#include "drsdef.h"
#include "temps.h"
#include "surfdat.h"

      integer ngrid

      REAL px(ngrid,llm)
      REAL dx3(iip1,jjp1,llm),dx2(iip1,jjp1)
      REAL dx0

      real date
      character*(*) nom,titre,unite

      REAL phis(ip1jmp1)

      integer unit, dim
      integer irythme
      integer ierr,setvdim,setname,putdat,putvdim,cluvdb,aslun
      integer it1, it2,iq
      integer i,j,l,zmax , ig0

      integer zitau
      character firstnom*10
      SAVE firstnom
      SAVE zitau
      SAVE date
      data firstnom /'1234567890'/
      data zitau /0/


c***************************************************************
c Sortie des variables au rythme voulu

      irythme = int(ecritphy) ! sortie au rythme de ecritphy
c     irythme = iconser  ! sortie au rythme des variables de controle
c     irythme = iphysiq  ! sortie a tous les pas physique
c     irythme = iecri*day_step ! sortie au rythme des fichiers histoires
c     irythme = periodav*day_step ! sortie au rythme des fichiers histmoy

c***************************************************************
c
c  initialisation de 'firstnom' / ouverture du fichier DRS
c  ------------------------------------------------------
c  (Au tout premier appel de la subroutine durant le run.)

      if (firstnom.eq.'1234567890') then
             firstnom = nom
             call gr_fi_dyn(1,ngrid,iip1,jjp1,phisfi,phis)
c   assign Logical Unit: ouverture du fichier DRS
             ierr = aslun(unit,'diagfi.dic',
     &             unit+1,'diagfi.dat',IDRS_CREATE)
c   ecriture de l'entete du fichier (longitudes, latitudes ... relief)
             call iniwrite(unit,.true.,day_ini , phis)
             zitau = -1
      endif

c incrementation de temps a chaque premier appel de WRITEDRSFI ds la physique
c ------------------------------------------------------------------------
c     write(*,*) 'ds writedrsfi , firstnom =', firstnom
c     write(*,*) 'ds writedrsfi , nom =', nom
      if (nom.eq.firstnom) then
          zitau = zitau + iphysiq
      end if
c     write(*,*) 'ds writedrsfi , zitau =', zitau

c --------------------------------------------------------
c Sortie des variables au rythme voulu
c --------------------------------------------------------

      if ( MOD(zitau+1,irythme) .eq.0.) then


c Calcul/ecriture/extension de la coordonnee temps (date en jours)
c --------------------------------------------------------
c (effectuee a chaque premier appel de WRITEDRSFI ds la physique)
c On date les sorties comme histoire, c.a.d un pas de temps plus loin !

c Detection du changement de temps
        if (nom.eq.firstnom) then
           date = float (zitau +1)/float (day_step)
           ierr = cluvdb()
           ierr = setname(' ','temps','temps simule','jours',' ')
           ierr = putvdim(unit,1,date,it1,it2)
           write(6,*)' WRITEDEM: it1, it2, ',it1 ,it2
        end if

c Cas Variable 3D
c ---------------
        if (dim.eq.3) then

c          Passage variable physique -->  physique dynamique

           DO l=1,llm
             DO i=1,iip1
                dx3(i,1,l)=px(1,l)
                dx3(i,jjp1,l)=px(ngrid,l)
             ENDDO
             DO j=2,jjm
                ig0= 1+(j-2)*iim
                DO i=1,iim
                   dx3(i,j,l)=px(ig0+i,l)
                ENDDO
                dx3(iip1,j,l)=dx3(1,j,l)
             ENDDO
           ENDDO

c          Ecriture du champs

c          write (*,*) 'In  WRITEDRSFI, on sauve:  ' , nom
c          write (*,*) 'In  WRITEDRSFI. Estimated date = ' ,date
           ierr = cluvdb()
c   choix du nom des coordonnees
           ierr = setvdim(1,' ','rlonv',' ',' ',rlonv(1),rlonv(iip1))
           ierr = setvdim(2,' ','rlatu',' ',' ',rlatu(1),rlatu(jjp1))
           ierr = setvdim(3,' ','sig_s',' ',' ',sig_s(1),sig_s(llm))
           ierr = setvdim(4,' ','temps',' ',' ',date,date)
c  nom de la variable
           ierr = setname('Diagnostique physique',nom,titre,unite,' ')
c   ecriture du cahmp
           ierr = putdat(unit,dx3)


c Cas Variable 2D
c ---------------

        else if (dim.eq.2) then

c          Passage variable physique -->  physique dynamique

             DO i=1,iip1
                dx2(i,1)=px(1,1)
                dx2(i,jjp1)=px(ngrid,1)
             ENDDO
             DO j=2,jjm
                ig0= 1+(j-2)*iim
                DO i=1,iim
                   dx2(i,j)=px(ig0+i,1)
                ENDDO
                dx2(iip1,j)=dx2(1,j)
             ENDDO

c          Ecriture du champs

c          write (*,*) 'In  WRITEDRSFI, on sauve:  ' , nom
c          write (*,*) 'In  WRITEDRSFI. Estimated date = ' ,date
           ierr = cluvdb()
           ierr = setvdim(1,' ','rlonv',' ',' ',rlonv(1),rlonv(iip1))
           ierr = setvdim(2,' ','rlatu',' ',' ',rlatu(1),rlatu(jjp1))
           ierr = setvdim(3,' ','temps',' ',' ',date,date)
           ierr = setname('Diagnostique physique',nom,titre,unite,' ')
           ierr = putdat(unit,dx2)

c Cas Variable 0D (scalaire dependant du temps)
c ---------------

        else if (dim.eq.0) then
           dx0 = px (1,1)

c          Ecriture du champs

c          write (*,*) 'In  WRITEDRSFI. Estimated date = ' ,date
           ierr = cluvdb()
           ierr = setvdim(1,' ','temps',' ',' ',date,date)
           ierr = setname('Diagnostique physique',nom,titre,unite,' ')
           ierr = putdat(unit,dx0)
        end if

      end if


      return
      end