*=*=*=*= writeavs.html =*=*=*=*
SUBROUTINE writeavs

SUBROUTINE writeavs


      SUBROUTINE writeavs(nq,pdtav,ptime,pu,pv,ph,pq,pp,ifin)
      IMPLICIT NONE

c      auteur : L.Fairhead


c=======================================================================
c
c   Ecriture des moyennes diurnes
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"

c   argusments:
c   ----------

      INTEGER itau,nq
      REAL pdtav
      REAL pu(ip1jmp1*llm),pv(ip1jm*llm),ph(ip1jmp1*llm)
      REAL pq(ip1jmp1*llm,nq)
      REAL pp(ip1jmp1)
      REAL ztime,ptime

c   local:
c   ------

      INTEGER idaym,idayp,i,ifin,l,iq
      INTEGER*4 iday,isec
      REAL zdtm,zdtp,dttot
      REAL zw,zwtot,zz
      REAL ztimem,ztimep,zdtime
      REAL um(ip1jmp1*llm),vm(ip1jm*llm),hm(ip1jmp1*llm)
      real us(ip1jmp1,llm),vs(ip1jmp1,llm)
      REAL qm(ip1jmp1*llm,nqmx)
      REAL pm(ip1jmp1),zpks(ip1jmp1)

      LOGICAL firstcal

      SAVE idaym
      SAVE um,vm,hm,qm,pm,dttot
      SAVE firstcal
      DATA firstcal/.true./
      INTEGER ierr
      INTEGER setname, cluvdb, setvdim, putdat, cllun, putvdim
      REAL time
      INTEGER it1, it2
      character str2*2,str3*3
c
      EXTERNAL exner_new

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'
         ENDIF
      ENDIF

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

      IF(ifin.EQ.0) THEN
         ztimep=ztime+.5*pdtav
      ELSE
         ztimep=ztime
c        zdtime=pdtav*.5
      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   --------------------------------------

      IF(idaym.EQ.idayp) THEN

         DO i=1,ijp1llm
            um(i)=um(i)+pu(i)
            hm(i)=hm(i)+ph(i)
         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)+pp(i)
         ENDDO
c        dttot=dttot+pdtav
         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)+ph(i)*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)+pp(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     ......    P. Le Van  (  modif   le 17/04/96  )   ......
c
            CALL exner_new(ip1jmp1,pm,.TRUE.,zpks,zpks)
            CALL multscal(ijp1llm,hm,1./cpp,hm)
            DO l=1,llm
               CALL multipl(ip1jmp1,hm((l-1)*ip1jmp1+1),
     s           zpks,hm((l-1)*ip1jmp1+1))
               CALL multscal(ip1jmp1,hm((l-1)*ip1jmp1+1),
     s           s(l),hm((l-1)*ip1jmp1+1))
            ENDDO
            CALL multipl(ip1jmp1,pm,unsaire,pm)


c  Ecriture/extension de la coordonnee temps
            ierr = CLUVDB()
            ierr = SETNAME(descript,'temps','temps simule',
     .                     'jours',' ')
            time = FLOAT(idayp)*period_av-.5*dttot
            print *,'time= ',time
            print*,'unitav = ',unitav
            ierr = PUTVDIM(unitav,1,time,it1,it2)

C on passe le vent sur la grille scalaire
            call gr_u_scal(llm,um,us)
            call gr_v_scal(llm,vm,vs)

C  Ecriture des champs
            print*,'Ecriture dans writeavs'
            ierr = CLUVDB()
c           ierr = SETVDIM(1,' ','temps',' ',' ',time,time)
c           ierr = SETNAME(descript,'dttot','periode moyennee',' ',' ')
c           ierr = PUTDAT(unitav,dttot)
            ierr = CLUVDB()
            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',' ',' ',time,time)
            ierr = SETNAME(descript,'u',
     .                     'vents u naturels moyennees','m/s',' ')
            ierr = PUTDAT(unitav,us)
            ierr = SETNAME(descript,'v',
     .                     'vents v naturels moyennes','m/s',' ')
            ierr = PUTDAT(unitav,vs)
            ierr = SETNAME(descript,'T',
     .                     'temperature moyennees','K',' ')
            ierr = PUTDAT(unitav,hm)
            IF(nq.GT.0) THEN
               DO iq=1,nq
                   str2(1:1)='q'
                   if(iq.le.9) then
                     str2(1:1)='q'
                     WRITE(str2(2:2),'(i1.1)') iq
                     ierr = setname(descript,str2,'traceur',' ',' ')
                     print*,'On ecrit la variable iq=',iq,' =',str2
                   else
                     str3(1:1)='q'
                     WRITE(str3(2:3),'(i2.2)') iq
                     ierr = setname(descript,str3,'traceur',' ',' ')
                     print*,'On ecrit la variable iq=',iq,' =',str3
                   endif
                   ierr = PUTDAT(unitav,qm(1,iq))
               ENDDO
            ENDIF
            ierr = CLUVDB()
            ierr = SETVDIM(1,' ','rlonv',' ',' ',rlonv(1),rlonv(iip1))
            ierr = SETVDIM(2,' ','rlatu',' ',' ',rlatu(1),rlatu(jjp1))
            ierr = SETVDIM(3,' ','temps',' ',' ',time,time)
            ierr = SETNAME(descript,'ps',
     .                     'pression extensive moyennee','Pa',' ')
            ierr = PUTDAT(unitav,pm)


         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)=ph(i)*zw
         ENDDO
c
         IF (nq.GT.0) THEN
            DO iq=1,nq
               DO i=1,ijp1llm
c
c   ....  P. Le Van ( modif  le 30/12/96 )  ......
                 qm(i,iq) = pq(i,iq) * zw
               ENDDO
            ENDDO
         ENDIF
c
         DO i=1,ijmllm
            vm(i)=pv(i)*zw
         ENDDO
         DO i=1,ip1jmp1
            pm(i)=pp(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 sauvegarde le champ  supplementaire

         PRINT*,'dttot 4',dttot
         IF(dttot.GT.1.e-5*period_av) THEN

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

c    ....  P.Le Van ( ajout le 30/12/96 )  .......
c
            IF (nq.GT.0) THEN
               DO iq=1,nq
                  DO i=1,ijp1llm
                     qm(i,iq)= qm(i,iq)*zwtot
                  ENDDO
               ENDDO
            ENDIF
c    .............................................

            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        ..........   P.Le Van  ( Modif le 22/12/95 )  ...........
c         .........      et  le  17/04/96         ..........
c
            CALL exner_new(ip1jmp1,pm,.TRUE.,zpks,zpks)
            CALL multscal(ijp1llm,hm,1./cpp,hm)
            DO l=1,llm
               CALL multipl(ip1jmp1,hm((l-1)*ip1jmp1+1),
     s           zpks,hm((l-1)*ip1jmp1+1))
               CALL multscal(ip1jmp1,hm((l-1)*ip1jmp1+1),
     s           s(l),hm((l-1)*ip1jmp1+1))
            ENDDO
c    ................................................................
c
            CALL multipl(ip1jmp1,pm,unsaire,pm)

c  Ecriture/extension de la coordonnee temps
            ierr = CLUVDB()
            ierr = SETNAME(descript,'temps','temps simule','jours',' ')
            time = FLOAT(idayp)*period_av-.5*dttot
            print *,'time= ',time
            ierr = PUTVDIM(unitav,1,time,it1,it2)

C on passe le vent sur la grille scalaire
            call gr_u_scal(llm,um,us)
            call gr_v_scal(llm,vm,vs)

C  Ecriture des champs
            print*,'Ecriture dans writeavs'
            ierr = CLUVDB()
            ierr = SETVDIM(1,' ','temps',' ',' ',time,time)
            ierr = SETNAME(descript,'dttot','periode moyennee',' ',' ')
            ierr = PUTDAT(unitav,dttot)
            ierr = CLUVDB()
            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',' ',' ',time,time)
            ierr = SETNAME(descript,'u',
     .                     'vents u naturels moyennees','m/s',' ')
            ierr = PUTDAT(unitav,us)
            ierr = SETNAME(descript,'v','vents v naturels moyennes'
     .                             ,'m/s',' ')
            ierr = PUTDAT(unitav,vs)
            ierr = SETNAME(descript,'T',
     .                     'temperature moyennees','K',' ')
            ierr = PUTDAT(unitav,hm)
c
c     ....  P. Le Van  ( ajout  le 30/12/96 )  ....
c
            IF(nq.GT.0) THEN
               DO iq=1,nq
                   str2(1:1)='q'
                   if(iq.le.9) then
                     str2(1:1)='q'
                     WRITE(str2(2:2),'(i1.1)') iq
                     ierr = setname(descript,str2,'traceur',' ',' ')
                     print*,'On ecrit la variable iq=',iq,' =',str2
                   else
                     str3(1:1)='q'
                     WRITE(str3(2:3),'(i2.2)') iq
                     ierr = setname(descript,str3,'traceur',' ',' ')
                     print*,'On ecrit la variable iq=',iq,' =',str3
                   endif
                   ierr = PUTDAT(unitav,qm(1,iq))
               ENDDO
            ENDIF
c
            ierr = CLUVDB()
            ierr = SETVDIM(1,' ','rlonv',' ',' ',rlonv(1),rlonv(iip1))
            ierr = SETVDIM(2,' ','rlatu',' ',' ',rlatu(1),rlatu(jjp1))
            ierr = SETVDIM(3,' ','temps',' ',' ',time,time)
            ierr = SETNAME(descript,'ps','pression extensive moyennee'
     .                             ,'Pa',' ')
            ierr = PUTDAT(unitav,pm)
         ENDIF
c        CLOSE(unitav)
C        ierr = CLLUN(unitav)
         RETURN
      ENDIF


      RETURN
      END