c $Header$ subroutine read_fstoke(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 integer imo,jmo,imo1,jmo1,imn,jmn parameter (imn=iim,jmn=jjm,imo=imn/2,jmo=(jmn+1)/2) parameter (imo1=imo+1,jmo1=jmo+1) real*4 pbaru(imo1,jmo1,llm),pbarv(imo1,jmo,llm) real*4 teta(imo1,jmo1,llm),phis(imo1,jmo1),phi(imo1,jmo1,llm) real*4 masse(imo1,jmo1,llm),w(imo1,jmo1,llm) real*4 airedy(imo1,jmo1) real*4 rlonu_dy(imo1,jmo1),rlonv_dy(imo1,jmo), . rlatu_dy(imo1,jmo1),rlatv_dy(imo1,jmo) 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*30 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 #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 print*,'WARNING!!! Correction bidon pour palier a un ' c print*,'probleme dans la creation des fichiers nc' c call correctbid(iim,jmo1*nlevnc,masse) print*,'***********Lecture MASSE ' call dump2d(imo1,jmo1,masse,'MASSE COUCHE 1') 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 print*,'WARNING!!! Correction bidon pour palier a un ' c print*,'probleme dans la creation des fichiers nc' c call correctbid(iim,jmo1*nlevnc,pbaru) c call dump2d(imo1,jmo1,pbaru,'PBARUNC COUCHE 1') 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 print*,'WARNING!!! Correction bidon pour palier a un ' c print*,'probleme dans la creation des fichiers nc' c call correctbid(iim,jmo1*nlevnc,w) c call dump2d(imo1,jmo1,w,'WNC COUCHE 1') 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 print*,'WARNING!!! Correction bidon pour palier a un ' c print*,'probleme dans la creation des fichiers nc' c call correctbid(iim,jmo1*nlevnc,teta) c call dump2d(imo1,jmo1,teta,'TETANC COUCHE 1') 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 c print*,'WARNING!!! Correction bidon pour palier a un ' c print*,'probleme dans la creation des fichiers nc' c call correctbid(iim,jmo1*nlevnc,phi) c call dump2d(imo1,jmo1,phi,'PHINC COUCHE 1') count(2) = zjm-1 c pbarv print*,'Lecture de pbarv irec=',irec #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 c call correctbid(iim,jjm*nlevnc,pbarv) PRINT*,'*******LECTURE DE PBARV******' call dump2d(imo1,jjm,pbarv,'PBARVNC COUCHE 1') print*,'Ok Lecture de pbarv irec=',irec start(3)=irec start(4)=0 count(2)=jmo1 count(3)=1 count(4)=0 endif print*,'Fin read_fstoke a irec=',irec return end