source: LMDZ.3.3/trunk/libf/dyn3d/read_fstoke0.F @ 5306

c $Header$
        subroutine read_fstoke0(irec,
     . zrec,zim,zjm,zlm,rlonu_dy,rlonv_dy,rlatu_dy,rlatv_dy,
     . airedy,phis,
     . masse,pbaru,pbarv,w,teta,phi)

        IMPLICIT NONE

#include "netcdf.inc"
#include "dimensions.h"
#include "paramet.h"
#include "comgeom.h"
#include "comvert.h"
        
      integer nlevnc,irec
      parameter (nlevnc=19)
      integer mode,l

      real*4 pbaru(iip1,jjp1,llm),pbarv(iip1,jjm,llm)
      real*4 teta(iip1,jjp1,llm),phis(iip1,jjp1),phi(iip1,jjp1,llm)
      real*4 masse(iip1,jjp1,llm),w(iip1,jjp1,llm)
      real*4 airedy(iip1,jjp1)
      real*4 rlonu_dy(iip1,jjp1),rlonv_dy(iip1,jjm),
     . rlatu_dy(iip1,jjp1),rlatv_dy(iip1,jjm)
      integer*4 ncrec,ncim,ncjm,nclm
      integer*4 zrec,zim,zjm,zlm
      integer*4 xid,yid,zid,tid
      real*4 zdtvr,ziadvtrac
      real adv(1), dtv(1)

      integer ncidf,ncidfv
      integer varidpu,varidpv,varidt,varidw,varidps,varidph,varidai
      integer varidpl,varidm
      integer varidnlo,varidnla,varidnlov,varidnlav
      save ncidf,ncidfv
      save varidpu,varidpv,varidt,varidw,varidps,varidph,varidai
      save varidpl,varidm
      save varidnlo,varidnla,varidnlov,varidnlav

      real*4 pl(nlevnc)

      integer start(4),count(4),status

      real rcode
        
      character namedim 
        
c ---------------------------------------------
c   Initialisation de la lecture des fichiers
c ---------------------------------------------

      if (irec .eq. 0) then

            ncidf=NCOPN('fluxstoke.nc',NCNOWRIT,rcode)

            varidps=NCVID(ncidf,'phis',rcode)
            print*,'ncidf,varidps',ncidf,varidps

            varidpl=NCVID(ncidf,'sig_s',rcode)
            print*,'ncidf,varidpl',ncidf,varidpl
        
            varidnlo=NCVID(ncidf,'nav_lon',rcode)
            print*,'ncidf,varidnlo',ncidf,varidnlo
          
            varidnla=NCVID(ncidf,'nav_lat',rcode)
            print*,'ncidf,varidnla',ncidf,varidnla
        
            varidai=NCVID(ncidf,'aire',rcode)
            print*,'ncidf,varidai',ncidf,varidai
         
            varidm=NCVID(ncidf,'masse',rcode)
            print*,'ncidf,varidm',ncidf,varidm

            varidpu=NCVID(ncidf,'pbaru',rcode)
            print*,'ncidf,varidpu',ncidf,varidpu
                
            varidw=NCVID(ncidf,'w',rcode)
            print*,'ncidf,varidw',ncidf,varidw
        
            varidt=NCVID(ncidf,'teta',rcode)
            print*,'ncidf,varidt',ncidf,varidt
 
            varidph=NCVID(ncidf,'phi',rcode)
            print*,'ncidf,varidph',ncidf,varidph
        
            ncidfv=NCOPN('fluxstokev.nc',NCNOWRIT,rcode)

            varidpv=NCVID(ncidfv,'pbarv',rcode)
            print*,'ncidfv,varidpv',ncidfv,varidpv
        
            varidnlov=NCVID(ncidfv,'nav_lon',rcode)
            print*,'ncidf,varidnlov',ncidf,varidnlov
          
            varidnlav=NCVID(ncidfv,'nav_lat',rcode)
            print*,'ncidfv,varidnlav',ncidfv,varidnlav
        

c ID pour les dimensions
        
            status = nf_inq_dimid(ncidf,'y',yid)
            status = nf_inq_dimid(ncidf,'x',xid)
            status = nf_inq_dimid(ncidf,'sig_s',zid) 
            status = nf_inq_dimid(ncidf,'time_counter',tid)

c lecture des dimensions
        
            status = nf_inq_dim(ncidf,yid,namedim,ncjm)
            status = nf_inq_dim(ncidf,xid,namedim,ncim)
            status = nf_inq_dim(ncidf,zid,namedim,nclm)
            status = nf_inq_dim(ncidf,tid,namedim,ncrec)
        
            zjm=ncjm
            zim=ncim
            zlm=nclm
            zrec=ncrec
        
            write(*,*) 'read_fstoke : zrec = ', zrec
            write(*,*) 'read_fstoke : zlm = ', zlm
            write(*,*) 'read_fstoke : zim = ', zim
            write(*,*) 'read_fstoke : zjm = ', zjm

c niveaux de pression
        
#ifdef NC_DOUBLE
       status=NF_GET_VARA_DOUBLE(ncidf,varidpl,1,zlm,pl)
#else
       status=NF_GET_VARA_REAL(ncidf,varidpl,1,zlm,pl)
#endif

c rlonu,rlonv,rlatu,rlatv
        
      start(1)=1
      start(2)=1
      start(3)=1
      start(4)=0

      count(1)=zim
      count(2)=zjm
      count(3)=1
      count(4)=0
        
#ifdef NC_DOUBLE
      status=NF_GET_VARA_DOUBLE(ncidf,varidnlo,start,count,rlonu_dy)
      status=NF_GET_VARA_DOUBLE(ncidf,varidnla,start,count,rlatu_dy)
#else
      status=NF_GET_VARA_REAL(ncidf,varidnlo,start,count,rlonu_dy)
      status=NF_GET_VARA_REAL(ncidf,varidnla,start,count,rlatu_dy)
#endif

      start(1)=1
      start(2)=1
      start(3)=1
      start(4)=0

      count(1)=zim
      count(2)=zjm-1
      count(3)=1
      count(4)=0

#ifdef NC_DOUBLE
      status=NF_GET_VARA_DOUBLE(ncidfv,varidnlov,start,count,rlonv_dy)
      status=NF_GET_VARA_DOUBLE(ncidfv,varidnlav,start,count,rlatv_dy)
#else
      status=NF_GET_VARA_REAL(ncidfv,varidnlov,start,count,rlonv_dy)
      status=NF_GET_VARA_REAL(ncidfv,varidnlav,start,count,rlatv_dy)
#endif

c Lecture de phis et aire
        
      start(1)=1
      start(2)=1
      start(3)=1
      start(4)=0

      count(1)=zim
      count(2)=zjm
      count(3)=1
      count(4)=0

c phis
#ifdef NC_DOUBLE
      status=NF_GET_VARA_DOUBLE(ncidf,varidps,start,count,phis)
#else
      status=NF_GET_VARA_REAL(ncidf,varidps,start,count,phis)
#endif

c aire
#ifdef NC_DOUBLE
       status=NF_GET_VARA_DOUBLE(ncidf,varidai,start,count,airedy)
#else
       status=NF_GET_VARA_REAL(ncidf,varidai,start,count,airedy)
#endif

       else 

      print*,'ok1'

c ---------------------
c   lecture des champs 
c ---------------------

      print*,'WARNING!!! Il n y a pas de test de coherence'
      print*,'sur le nombre de niveaux verticaux dans le fichier nc'

      start(1)=1
      start(2)=1
      start(3)=1
      start(4)=irec

      count(1)=zim
      count(2)=zjm
      count(3)=zlm
      count(4)=1

c masse 
        PRINT*,'LECTURE DE masse'
#ifdef NC_DOUBLE
      status=NF_GET_VARA_DOUBLE(ncidf,varidm,start,count,masse)
#else
      status=NF_GET_VARA_REAL(ncidf,varidm,start,count,masse)
#endif

c pbaru 
#ifdef NC_DOUBLE
      status=NF_GET_VARA_DOUBLE(ncidf,varidpu,start,count,pbaru)
#else
      status=NF_GET_VARA_REAL(ncidf,varidpu,start,count,pbaru)
#endif

c w 
#ifdef NC_DOUBLE
      status=NF_GET_VARA_DOUBLE(ncidf,varidw,start,count,w)
#else
      status=NF_GET_VARA_REAL(ncidf,varidw,start,count,w)
#endif

c teta 
#ifdef NC_DOUBLE
      status=NF_GET_VARA_DOUBLE(ncidf,varidt,start,count,teta)
#else
      status=NF_GET_VARA_REAL(ncidf,varidt,start,count,teta)
#endif

c phi 
#ifdef NC_DOUBLE
      status=NF_GET_VARA_DOUBLE(ncidf,varidph,start,count,phi)
#else
      status=NF_GET_VARA_REAL(ncidf,varidph,start,count,phi)
#endif
        
        count(2) = zjm-1 

c  pbarv
#ifdef NC_DOUBLE
      status=NF_GET_VARA_DOUBLE(ncidfv,varidpv,start,count,pbarv)
#else
      status=NF_GET_VARA_REAL(ncidfv,varidpv,start,count,pbarv)
#endif

      start(3)=irec
      start(4)=0
      count(2)=jjp1
      count(3)=1
      count(4)=0

        endif

      return
      end