SUBROUTINE writeav(fichnom,nq,pdtav,ptime,pu,pv,
     .                   pteta,ppk,pq,pps,ifin)

      IMPLICIT NONE

c      Auteur :  L.Fairhead

c      Modif. par P. Le Van ( 01/11/97 )

c=======================================================================
c
c   Ecriture des moyennes diurnes  sur le fichier ' histmoy ' , avec

c   la grille ' dynamique ' , c.a.d  decalee , u et v n'etant pas aux
c   memes endroits que les scalaires .
c   On ecrit la moyenne tous les jours
c   si ifin NE 0  on ecrit la moyenne et on ferme le fichier histoire
c
c=======================================================================
c   Declarations:
c   -------------

#include "dimensions.h"
#include "paramet.h"
#include "comav.h"
#include "comvert.h"
#include "comconst.h"
#include "comgeom.h"
#include "description.h"
#include "netcdf.inc"

c   arguments:
c   ----------

      CHARACTER*(*) fichnom
      INTEGER nq
      REAL pdtav
      REAL pu(ip1jmp1*llm),pv(ip1jm*llm),pteta(ip1jmp1*llm)
      REAL ppk(ip1jmp1*llm),pq(ip1jmp1*llm,nq)
      REAL pps(ip1jmp1)
      REAL ztime,ptime

c   local:
c   ------

      INTEGER idaym,idayp,i,ifin,iq
      REAL zdtm,zdtp,dttot
      REAL zw,zwtot,zz
      REAL ztimem,ztimep,zdtime
      REAL um(ip1jmp1*llm),vm(ip1jm*llm),hm(ip1jmp1*llm)
      REAL qm(ip1jmp1*llm,nqmx)
      REAL pm(ip1jmp1)

      LOGICAL firstcal

      SAVE idaym
      SAVE um,vm,hm,qm,pm,dttot
      SAVE firstcal
      DATA firstcal/.true./
      INTEGER ierr, nid, nvarid
      REAL time
      CHARACTER*3 str3
c
      INTEGER nb
      SAVE nb
      DATA nb / 0 /

c-----------------------------------------------------------------------
c   calcul de la position par rapport aux jours pleins:
c   ---------------------------------------------------

      IF(firstcal) THEN
         zz=-time0_av/period_av
         idaym=INT(zz)
         IF(zz.LT.0.) idaym=idaym-1
         dttot=0.
         CALL initial0(ijp1llm,um)
         CALL initial0(ijmllm,vm)
         CALL initial0(ijp1llm,hm)
         IF(nq.GT.0) CALL initial0(ijp1llm*nq,qm)
         CALL initial0(ip1jmp1,pm)
         IF(nq.GT.nqmx) THEN
            PRINT*,'Il faut augmenter nqmx dans writeav.f'
            STOP ' writeav '
         ENDIF
      ENDIF

      ztime=ptime-time0_av
      zdtime=pdtav
      IF(firstcal) THEN
         ztimem = 0.
      ELSE
         ztimem=ztime-.5*pdtav
      ENDIF
      firstcal=.false.

      IF(ifin.EQ.0) THEN
         ztimep=ztime+.5*pdtav
      ELSE
         ztimep=ztime
      ENDIF

      zdtime = ztimep-ztimem
      zz=ztimep/period_av
      idayp=INT(zz)
      IF(zz.LT.0.) idayp=idayp-1

C     PRINT*,period_av,ptime,ztime,idaym,idayp

c-----------------------------------------------------------------------
c   premier cas: on ne change pas de jour:
c   --------------------------------------

c    .......   hm  calcule  les temperatures  naturelles  .......

      IF(idaym.EQ.idayp) THEN

         DO i=1,ijp1llm
            um(i)=um(i)+pu(i)
            hm(i)=hm(i)+pteta(i) * ppk(i)/cpp
         ENDDO
         IF(nq.GT.0) THEN
            DO iq=1,nq
               DO i=1,ijp1llm
                  qm(i,iq)=qm(i,iq)+pq(i,iq)
               ENDDO
            ENDDO
         ENDIF
         DO i=1,ijmllm
            vm(i)=vm(i)+pv(i)
         ENDDO
         DO i=1,ip1jmp1
            pm(i)=pm(i)+pps(i)
         ENDDO
         dttot=dttot + (ztimep - ztimem)

c-----------------------------------------------------------------------
c   deuxieme cas: on change de jour dans dtav:
c   ------------------------------------------

      ELSE

         zdtp=ztimep-FLOAT(idayp)*period_av
         zdtm=zdtime-zdtp

c   ajout partiel sur le jour precedent:
c   ------------------------------------

         dttot=dttot+zdtm

         IF(dttot.GT.period_av*1.e-5) THEN
            zwtot=pdtav/dttot
            zw=zdtm/pdtav

            DO i=1,ijp1llm
               um(i)=(um(i)+pu(i)*zw)*zwtot
               hm(i)=(hm(i)+pteta(i)*ppk(i)/cpp*zw)*zwtot
            ENDDO


            IF (nq.GT.0) THEN
               DO iq=1,nq
                  DO i=1,ijp1llm
                     qm(i,iq)=(qm(i,iq)+pq(i,iq)*zw)*zwtot
                  ENDDO
               ENDDO
            ENDIF
            DO i=1,ijmllm
               vm(i)=(vm(i)+pv(i)*zw)*zwtot
            ENDDO
            DO i=1,ip1jmp1
               pm(i)=(pm(i)+pps(i)*zw)*zwtot
            ENDDO

c   ecriture du fichier de moyenne:
c   -------------------------------

c   transformation en variables naturelles:
c   ---------------------------------------
            CALL covnat(llm,um,vm,um,vm)
c
c Ouverture du fichier:
c
      ierr = NF_OPEN(fichnom, NF_WRITE, nid)
      IF (ierr .NE. NF_NOERR) THEN
         PRINT*, "Pb. d ouverture "//fichnom
         CALL abort
      ENDIF
c
c  Ecriture/extension de la coordonnee temps
      nb = nb + 1
      ierr = NF_INQ_VARID(nid, "temps", nvarid)
      IF (ierr .NE. NF_NOERR) THEN
         PRINT*, "writeav: Variable temps n est pas definie"
         CALL abort
      ENDIF
      time = FLOAT(idayp)*period_av-.5*dttot
#ifdef NC_DOUBLE
      ierr = NF_PUT_VAR1_DOUBLE (nid,nvarid,nb,time)
#else
      ierr = NF_PUT_VAR1_REAL (nid,nvarid,nb,time)
#endif
      PRINT*, "Enregistrement pour ", nb, time, fichnom

C  Ecriture des champs
      ierr = NF_INQ_VARID(nid, "temp", nvarid)
      IF (ierr .NE. NF_NOERR) THEN
         PRINT*, "writeav: Variable temp n est pas definie"
         CALL abort
      ENDIF
#ifdef NC_DOUBLE
      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,hm)
#else
      ierr = NF_PUT_VAR_REAL (nid,nvarid,hm)
#endif

c
      ierr = NF_INQ_VARID(nid, "vitu", nvarid)
      IF (ierr .NE. NF_NOERR) THEN
         PRINT*, "writeav: Variable vitu n est pas definie"
         CALL abort
      ENDIF
#ifdef NC_DOUBLE
      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,um)
#else
      ierr = NF_PUT_VAR_REAL (nid,nvarid,um)
#endif

      ierr = NF_INQ_VARID(nid, "vitv", nvarid)
      IF (ierr .NE. NF_NOERR) THEN
         PRINT*, "writeav: Variable vitv n est pas definie"
         CALL abort
      ENDIF
#ifdef NC_DOUBLE
      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,vm)
#else
      ierr = NF_PUT_VAR_REAL (nid,nvarid,vm)
#endif
c
      IF(nq.GE.1) THEN
      DO iq=1,nq
      IF ( iq.GT.99 ) THEN
         PRINT*, "Trop de traceurs"
         CALL abort
      ELSE
         str3(1:1)='q'
         WRITE(str3(2:3),'(i2.2)') iq
         ierr = NF_INQ_VARID(nid, str3, nvarid)
         IF (ierr .NE. NF_NOERR) THEN
            PRINT*, "writeav: Variable "//str3//" n est pas definie"
            CALL abort
         ENDIF
      ENDIF
#ifdef NC_DOUBLE
         ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,qm(1,iq))
#else
         ierr = NF_PUT_VAR_REAL (nid,nvarid,qm(1,iq))
#endif
      ENDDO
      ENDIF
c
      ierr = NF_INQ_VARID(nid, "ps", nvarid)
      IF (ierr .NE. NF_NOERR) THEN
         PRINT*, "writeav: Variable ps n est pas definie"
         CALL abort
      ENDIF
#ifdef NC_DOUBLE
      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pps)
#else
      ierr = NF_PUT_VAR_REAL (nid,nvarid,pps)
#endif

      ierr = NF_CLOSE(nid)
c

         ENDIF

c   ajout partiel sur le jour suivant:
c   ----------------------------------

         dttot=zdtp
c        PRINT*,'dttot=zdtp',dttot
         zw=zdtp/pdtav

         DO i=1,ijp1llm
            um(i)=pu(i)*zw
            hm(i)=pteta(i)*ppk(i)/cpp*zw
         ENDDO
         IF (nq.GT.0) THEN
            DO iq=1,nq
               DO i=1,ijp1llm
                  qm(i,iq)=qm(i,iq)*zw
               ENDDO
            ENDDO
         ENDIF
         DO i=1,ijmllm
            vm(i)=pv(i)*zw
         ENDDO
         DO i=1,ip1jmp1
            pm(i)=pps(i)*zw
         ENDDO

      ENDIF

      idaym=idayp


c-----------------------------------------------------------------------
c   ecriture en fin de run et fermeture du fichier:
c   -----------------------------------------------

      IF(ifin.NE.0) THEN
c si un temps non negligeable s'est ecoule depuis la derniere ecriture
c on sauve garde le champs supplementaire

         IF(dttot.GT.1.e-5*period_av) THEN

            zwtot=pdtav/dttot
            DO i=1,ijp1llm
               um(i)=um(i)*zwtot
               hm(i)=hm(i)*zwtot
            ENDDO

            DO i=1,ijmllm
               vm(i)=vm(i)*zwtot
            ENDDO
            DO i=1,ip1jmp1
               pm(i)=pm(i)*zwtot
            ENDDO

            CALL covnat(llm,um,vm,um,vm)

c
c Ouverture du fichier:
c
      ierr = NF_OPEN(fichnom, NF_WRITE, nid)
      IF (ierr .NE. NF_NOERR) THEN
         PRINT*, "Pb. d ouverture "//fichnom
         CALL abort
      ENDIF
           
c  Ecriture/extension de la coordonnee temps
      nb = nb + 1
      ierr = NF_INQ_VARID(nid, "temps", nvarid)
      IF (ierr .NE. NF_NOERR) THEN
         PRINT*, "writeav: Variable temps n est pas definie"
         CALL abort
      ENDIF
      time = FLOAT(idayp)*period_av-.5*dttot
#ifdef NC_DOUBLE
      ierr = NF_PUT_VAR1_DOUBLE (nid,nvarid,nb,time)
#else
      ierr = NF_PUT_VAR1_REAL (nid,nvarid,nb,time)
#endif
      PRINT*, "Enregistrement pour ", nb, time, fichnom

C  Ecriture des champs
      ierr = NF_INQ_VARID(nid, "temp", nvarid)
      IF (ierr .NE. NF_NOERR) THEN
         PRINT*, "writeav: Variable temp n est pas definie"
         CALL abort
      ENDIF
#ifdef NC_DOUBLE
      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,hm)
#else
      ierr = NF_PUT_VAR_REAL (nid,nvarid,hm)
#endif

c
      ierr = NF_INQ_VARID(nid, "vitu", nvarid)
      IF (ierr .NE. NF_NOERR) THEN
         PRINT*, "writeav: Variable vitu n est pas definie"
         CALL abort
      ENDIF
#ifdef NC_DOUBLE
      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,um)
#else
      ierr = NF_PUT_VAR_REAL (nid,nvarid,um)
#endif

      ierr = NF_INQ_VARID(nid, "vitv", nvarid)
      IF (ierr .NE. NF_NOERR) THEN
         PRINT*, "writeav: Variable vitv n est pas definie"
         CALL abort
      ENDIF
#ifdef NC_DOUBLE
      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,vm)
#else
      ierr = NF_PUT_VAR_REAL (nid,nvarid,vm)
#endif
c
      IF(nq.GE.1) THEN
      DO iq=1,nq
      IF ( iq.GT.99 ) THEN
         PRINT*, "Trop de traceurs"
         CALL abort
      ELSE
         str3(1:1)='q'
         WRITE(str3(2:3),'(i2.2)') iq
         ierr = NF_INQ_VARID(nid, str3, nvarid)
         IF (ierr .NE. NF_NOERR) THEN
            PRINT*, "writeav: Variable "//str3//" n est pas definie"
            CALL abort
         ENDIF
      ENDIF
#ifdef NC_DOUBLE
         ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,qm(1,iq))
#else
         ierr = NF_PUT_VAR_REAL (nid,nvarid,qm(1,iq))
#endif
      ENDDO
      ENDIF
c
      ierr = NF_INQ_VARID(nid, "ps", nvarid)
      IF (ierr .NE. NF_NOERR) THEN
         PRINT*, "writeav: Variable ps n est pas definie"
         CALL abort
      ENDIF
#ifdef NC_DOUBLE
      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pps)
#else
      ierr = NF_PUT_VAR_REAL (nid,nvarid,pps)
#endif

      ierr = NF_CLOSE(nid)
c

         ENDIF
         RETURN
      ENDIF

      RETURN
      END