!copyright (C) 2001  MSC-RPN COMM  %%%RPNPHY%%%
***S/R SERECRI  ECRIRE LES SERIES TEMPORELLES POUR UN POINT SUR
*               FICHIER STANDARD
*

      SUBROUTINE SERECRI(VS,VV,IUN,NSURF,NPROF,NT,SURFACE,PROFILS, 1,4
     1                   NUM,DLAT,DLON,STORE, S, PTOIT, ETATOIT,
     2                   DIAGNOS, DATE, ETIKET, H0, NK, SATUES, SATUCO)
*
#include "impnone.cdk"
      INTEGER NSURF,NPROF
      CHARACTER *(*) SURFACE(*),PROFILS(*)
      CHARACTER NOMVAR*4,ETIKET*8
      INTEGER   NK,NT,NUM,IUN,IECR
      REAL      STORE(*),DLAT,DLON,H0
      REAL      S(NK),DIAGNOS(NK,NT),VS(NT,*),VV(NK,NT,*)
      REAL      PTOIT, ETATOIT
      INTEGER   DATE,DEET,FSTECR
      LOGICAL   SATUES, SATUCO
*
*Author
*          R. Benoit
*
*Revision
* 001      V.Alex.(Feb 87) Documentation
* 002      N. Brunet  (May90)
*                Standardization of thermodynamic functions
* 003      N. Brunet  (May91)
*                New version of thermodynamic functions
*                and file of constants
* 004      B. Bilodeau  (July 1991)- Adaptation to UNIX
* 005      B. Bilodeau  (August 1992)   - Delete HR
* 006      G. Pellerin (April 1992) - Adaptation to PASTEMP,
*          clean-up of code
* 007      B. Bilodeau (Jan 1997) - Calculations of TH moved
*                from serecri to serdyn4; calculation of TW
*                generalized for GEF.
*
*Object
*          to write the time-series for one point in a standard file
*
*Arguments
*
*          - Input -
* VS       time-serie values of surface variables requested
* VV       time-serie values of profile variables requested
*
*          - Output -
* IUN      unit number attached to standard file
*
*          - Input -
* NSURF    number of surface variables requested
* NPROF    number of profile variables requested
* NT       timestep number
* SURFACE  names of time serie surface variables requested
* PROFILS  names of time serie profile variables requested
* NUM      station number
* DLAT     latitude
* DLON     longitude of station
* STORE    work field
* S        sigma (or eta) levels
* PTOIT    pressure value at the top of the model
* ETATOIT  eta value at the top of model
* DIAGNOS  fields to write
* DATE     date
* ETIKET   label for the standard record
* H0       GMT time
* NK       vertical dimension
* SATUES   .TRUE. if water/ice phase for saturation
*          (for entry/output)
*          .FALSE. if water phase only for saturation
*          (for entry/output)
* SATUCO   .TRUE. if water/ice phase for saturation
*          .FALSE. if water phase only for saturation
*
*
*MODULES
      INTEGER INDSERI
      EXTERNAL FSTECR,INDSERI
      EXTERNAL STHTAW
      REAL STHTAW
*
*
**
      CHARACTER*1 VT
      REAL PS,T,P,Q
      INTEGER KSURF,KPROF,JT,IS
      INTEGER NPAS,IP1,IP2,IP3,IG1,IG2,IG3,IG4,NPAK,DATYP
      INTEGER IELAQ,IELAT,IELAP0
      SAVE    IELAQ,IELAT,IELAP0
#include "consphy.cdk"
#include "dintern.cdk"
#include "fintern.cdk"
*
* PARAMETRES DE GRILLE CONFORMES A LA DOCUMENTATION DE PASTEMP
      VT   = 'T'
      DEET = 0
      NPAS = 0
      IP1  = 0
      IP2  = H0*100.
      IP3  = NUM
      IG1  = 0
      IG2  = 0
      IG3  = (DLAT+100.)*100.+0.5
      IG4  = DLON*100.+0.5
*
      DO 10 KSURF=1,NSURF
      IF(SURFACE(KSURF).EQ.'Z0')THEN
        NPAK=1
        DATYP=5
      ELSE
        NPAK=-16
        DATYP=1
      ENDIF
      NOMVAR=SURFACE(KSURF)
      IF(NOMVAR.NE.'  ') THEN
      IECR = FSTECR(VS(1,KSURF),STORE,NPAK,IUN,DATE,DEET,NPAS,1,NT,1,
     1      IP1,IP2,IP3,VT,NOMVAR,ETIKET,'+',IG1,IG2,IG3,IG4,DATYP,.FALSE.)
      ENDIF
10    CONTINUE
*
      NPAK=-24
      DATYP=1
      DO 20 KPROF=1,NPROF
      NOMVAR=PROFILS(KPROF)
      IF(NOMVAR.NE.'  ') THEN
      IECR = FSTECR(VV(1,1,KPROF),STORE,NPAK,IUN,DATE,DEET,NPAS,NK,NT,1,
     1      IP1,IP2,IP3,VT,NOMVAR,ETIKET,'+',IG1,IG2,IG3,IG4,DATYP,.FALSE.)
      ENDIF
20    CONTINUE
*
*  SERIE ADDITIONNELLE DIAGNOSTIQUE : THETA WET
*  (TEMPERATURE POTENTIELLE DU THERMOMETRE MOUILLE)
*
      IELAP0=INDSERI('P0',SURFACE,NSURF)
      IELAQ=INDSERI('HU',PROFILS,NPROF)
      IELAT=INDSERI('TT',PROFILS,NPROF)
*
      IF(IELAP0*IELAQ*IELAT.GT.0) THEN
*
      DO 50 JT=1,NT
         PS=VS(JT,IELAP0)
         DO 50 IS=1,NK
            T=VV(IS,JT,IELAT)
            Q=VV(IS,JT,IELAQ)
*           S EST LE VECTEUR COLONNE DES COORDONNEES ETA
            P=((1.-S(IS))*PTOIT + (S(IS)-ETATOIT)*PS) / (1.-ETATOIT)
            DIAGNOS(IS,JT) = STHTAW(Q,T,P,-1.,0,.TRUE.,SATUES,
     +                             .TRUE.)
50    CONTINUE
*
      IECR = FSTECR(DIAGNOS,STORE,NPAK,IUN,DATE,DEET,NPAS,NK,NT,1,
     1       IP1,IP2,IP3,VT,'TW',ETIKET,'+',IG1,IG2,IG3,IG4,DATYP,.FALSE.)
*
      ENDIF
*
      RETURN
      END