subroutine read_pstoke0(irec, . zrec,zkon,zkev,airefi,phisfi, . t,mfu,mfd,en_u,de_u,en_d,de_d,coefh, . frac_impa,frac_nucl,pyu1,pyv1,ftsol,psrf) IMPLICIT NONE #include "netcdf.inc" #include "dimensions.h" #include "paramet.h" #include "comconst.h" #include "comgeom.h" #include "temps.h" #include "ener.h" #include "logic.h" #include "description.h" #include "serre.h" #include "indicesol.h" #include "control.h" #include "dimphy.h" integer*4 kon,kev,zkon,zkev parameter(kon=iim*(jjm-1)+2,kev=llm) REAL*4 phisfi(kon) REAL*4 phisfi2(iim,jjm+1),airefi2(iim,jjm+1) REAL*4 mfu(kon,kev), mfd(kon,kev) REAL*4 en_u(kon,kev), de_u(kon,kev) REAL*4 en_d(kon,kev), de_d(kon,kev) REAL*4 coefh(kon,kev) REAL*4 t(kon,kev) REAL*4 mfu2(iim,jjm+1,kev), mfd2(iim,jjm+1,kev) REAL*4 en_u2(iim,jjm+1,kev), de_u2(iim,jjm+1,kev) REAL*4 en_d2(iim,jjm+1,kev), de_d2(iim,jjm+1,kev) REAL*4 coefh2(iim,jjm+1,kev) REAL*4 t2(iim,jjm+1,kev) REAL*4 pl(kev) integer irec integer*4 xid,yid,zid,tid integer*4 zrec,zim,zjm integer*4 ncrec,nckon,nckev,ncim,ncjm real*4 airefi(kon) character namedim c !! attention !! c attention il y a aussi le pb de def kon c dim de phis?? REAL*4 frac_impa(kon,kev), frac_nucl(kon,kev) REAL*4 frac_impa2(iim,jjm+1,kev), . frac_nucl2(iim,jjm+1,kev) REAL*4 pyu1(kon), pyv1(kon) REAL*4 pyu12(iim,jjm+1), pyv12(iim,jjm+1) REAL*4 ftsol(kon,nbsrf) REAL*4 psrf(kon,nbsrf) REAL*4 ftsol1(kon),ftsol2(kon),ftsol3(kon),ftsol4(kon) REAL*4 psrf1(kon),psrf2(kon),psrf3(kon),psrf4(kon) REAL*4 ftsol12(iim,jjm+1),ftsol22(iim,jjm+1), . ftsol32(iim,jjm+1), . ftsol42(iim,jjm+1) REAL*4 psrf12(iim,jjm+1),psrf22(iim,jjm+1),psrf32(iim,jjm+1), . psrf42(iim,jjm+1) integer ncidp save ncidp integer varidmfu, varidmfd, varidps, varidenu, variddeu integer varidt integer varidend,varidded,varidch,varidfi,varidfn integer varidyu1,varidyv1,varidpl,varidai,varididvt integer varidfts1,varidfts2,varidfts3,varidfts4 integer varidpsr1,varidpsr2,varidpsr3,varidpsr4 save varidmfu, varidmfd, varidps, varidenu, variddeu save varidt save varidend,varidded,varidch,varidfi,varidfn save varidyu1,varidyv1,varidpl,varidai,varididvt save varidfts1,varidfts2,varidfts3,varidfts4 save varidpsr1,varidpsr2,varidpsr3,varidpsr4 integer l, i integer start(4),count(4),status real rcode logical first save first data first/.true./ c --------------------------------------------- c Initialisation de la lecture des fichiers c --------------------------------------------- if (irec .eq. 0) then ncidp=NCOPN('phystoke.nc',NCNOWRIT,rcode) varidps=NCVID(ncidp,'phis',rcode) print*,'ncidp,varidps',ncidp,varidps varidpl=NCVID(ncidp,'sig_s',rcode) print*,'ncidp,varidpl',ncidp,varidpl varidai=NCVID(ncidp,'aire',rcode) print*,'ncidp,varidai',ncidp,varidai varidmfu=NCVID(ncidp,'mfu',rcode) print*,'ncidp,varidmfu',ncidp,varidmfu varidt=NCVID(ncidp,'t',rcode) print*,'ncidp,varidt',ncidp,varidt varidmfd=NCVID(ncidp,'mfd',rcode) print*,'ncidp,varidmfd',ncidp,varidmfd varidenu=NCVID(ncidp,'en_u',rcode) print*,'ncidp,varidenu',ncidp,varidenu variddeu=NCVID(ncidp,'de_u',rcode) print*,'ncidp,variddeu',ncidp,variddeu varidend=NCVID(ncidp,'en_d',rcode) print*,'ncidp,varidend',ncidp,varidend varidded=NCVID(ncidp,'de_d',rcode) print*,'ncidp,varidded',ncidp,varidded varidch=NCVID(ncidp,'coefh',rcode) print*,'ncidp,varidch',ncidp,varidch varidfi=NCVID(ncidp,'frac_impa',rcode) print*,'ncidp,varidfi',ncidp,varidfi varidfn=NCVID(ncidp,'frac_nucl',rcode) print*,'ncidp,varidfn',ncidp,varidfn varidyu1=NCVID(ncidp,'pyu1',rcode) print*,'ncidp,varidyu1',ncidp,varidyu1 varidyv1=NCVID(ncidp,'pyv1',rcode) print*,'ncidp,varidyv1',ncidp,varidyv1 varidfts1=NCVID(ncidp,'ftsol1',rcode) print*,'ncidp,varidfts1',ncidp,varidfts1 varidfts2=NCVID(ncidp,'ftsol2',rcode) print*,'ncidp,varidfts2',ncidp,varidfts2 varidfts3=NCVID(ncidp,'ftsol3',rcode) print*,'ncidp,varidfts3',ncidp,varidfts3 varidfts4=NCVID(ncidp,'ftsol4',rcode) print*,'ncidp,varidfts4',ncidp,varidfts4 varidpsr1=NCVID(ncidp,'psrf1',rcode) print*,'ncidp,varidpsr1',ncidp,varidpsr1 varidpsr2=NCVID(ncidp,'psrf2',rcode) print*,'ncidp,varidpsr2',ncidp,varidpsr2 varidpsr3=NCVID(ncidp,'psrf3',rcode) print*,'ncidp,varidpsr3',ncidp,varidpsr3 varidpsr4=NCVID(ncidp,'psrf4',rcode) print*,'ncidp,varidpsr4',ncidp,varidpsr4 c ID pour les dimensions status = nf_inq_dimid(ncidp,'y',yid) status = nf_inq_dimid(ncidp,'x',xid) status = nf_inq_dimid(ncidp,'sig_s',zid) status = nf_inq_dimid(ncidp,'time_counter',tid) c lecture des dimensions status = nf_inq_dim(ncidp,yid,namedim,ncjm) status = nf_inq_dim(ncidp,xid,namedim,ncim) status = nf_inq_dim(ncidp,zid,namedim,nckev) status = nf_inq_dim(ncidp,tid,namedim,ncrec) zrec=ncrec zkev=nckev zim=ncim zjm=ncjm zkon=zim*(zjm-2)+2 write(*,*) 'read_pstoke : zrec = ', zrec write(*,*) 'read_pstoke : kev = ', zkev write(*,*) 'read_pstoke : zim = ', zim write(*,*) 'read_pstoke : zjm = ', zjm write(*,*) 'read_pstoke : kon = ', zkon c niveaux de pression #ifdef NC_DOUBLE status=NF_GET_VARA_DOUBLE(ncidp,varidpl,1,kev,pl) #else status=NF_GET_VARA_REAL(ncidp,varidpl,1,kev,pl) #endif c lecture de aire et phis 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 c phis #ifdef NC_DOUBLE status=NF_GET_VARA_DOUBLE(ncidp,varidps,start,count,phisfi2) #else status=NF_GET_VARA_REAL(ncidp,varidps,start,count,phisfi2) #endif call gr_ecrit_fi(1,kon,iim,jjm+1,phisfi2,phisfi) c aire #ifdef NC_DOUBLE status=NF_GET_VARA_DOUBLE(ncidp,varidai,start,count,airefi2) #else status=NF_GET_VARA_REAL(ncidp,varidai,start,count,airefi2) #endif call gr_ecrit_fi(1,kon,iim,jjm+1,airefi2,airefi) 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)=kev count(4)=1 c frac_impa #ifdef NC_DOUBLE status=NF_GET_VARA_DOUBLE(ncidp,varidfi,start,count,frac_impa2) #else status=NF_GET_VARA_REAL(ncidp,varidfi,start,count,frac_impa2) #endif call gr_ecrit_fi(kev,kon,iim,jjm+1,frac_impa2,frac_impa) c frac_nucl #ifdef NC_DOUBLE status=NF_GET_VARA_DOUBLE(ncidp,varidfn,start,count,frac_nucl2) #else status=NF_GET_VARA_REAL(ncidp,varidfn,start,count,frac_nucl2) #endif call gr_ecrit_fi(kev,kon,iim,jjm+1,frac_nucl2,frac_nucl) c abder t #ifdef NC_DOUBLE status=NF_GET_VARA_DOUBLE(ncidp,varidt,start,count,t2) #else status=NF_GET_VARA_REAL(ncidp,varidt,start,count,t2) #endif call gr_ecrit_fi(kev,kon,iim,jjm+1,t2,t) c mfu #ifdef NC_DOUBLE status=NF_GET_VARA_DOUBLE(ncidp,varidmfu,start,count,mfu2) #else status=NF_GET_VARA_REAL(ncidp,varidmfu,start,count,mfu2) #endif call gr_ecrit_fi(kev,kon,iim,jjm+1,mfu2,mfu) c mfd #ifdef NC_DOUBLE status=NF_GET_VARA_DOUBLE(ncidp,varidmfd,start,count,mfd2) #else status=NF_GET_VARA_REAL(ncidp,varidmfd,start,count,mfd2) #endif call gr_ecrit_fi(kev,kon,iim,jjm+1,mfd2,mfd) c en_u #ifdef NC_DOUBLE status=NF_GET_VARA_DOUBLE(ncidp,varidenu,start,count,en_u2) #else status=NF_GET_VARA_REAL(ncidp,varidenu,start,count,en_u2) #endif call gr_ecrit_fi(kev,kon,iim,jjm+1,en_u2,en_u) c de_u #ifdef NC_DOUBLE status=NF_GET_VARA_DOUBLE(ncidp,variddeu,start,count,de_u2) #else status=NF_GET_VARA_REAL(ncidp,variddeu,start,count,de_u2) #endif call gr_ecrit_fi(kev,kon,iim,jjm+1,de_u2,de_u) c en_d #ifdef NC_DOUBLE status=NF_GET_VARA_DOUBLE(ncidp,varidend,start,count,en_d2) #else status=NF_GET_VARA_REAL(ncidp,varidend,start,count,en_d2) #endif call gr_ecrit_fi(kev,kon,iim,jjm+1,en_d2,en_d) c de_d #ifdef NC_DOUBLE status=NF_GET_VARA_DOUBLE(ncidp,varidded,start,count,de_d2) #else status=NF_GET_VARA_REAL(ncidp,varidded,start,count,de_d2) #endif call gr_ecrit_fi(kev,kon,iim,jjm+1,de_d2,de_d) c coefh print*,'LECTURE de coefh a irec =',irec #ifdef NC_DOUBLE status=NF_GET_VARA_DOUBLE(ncidp,varidch,start,count,coefh2) #else status=NF_GET_VARA_REAL(ncidp,varidch,start,count,coefh2) #endif call gr_ecrit_fi(kev,kon,iim,jjm+1,coefh2,coefh) start(3)=irec start(4)=0 count(3)=1 count(4)=0 c pyu1 print*,'LECTURE de yu1 a irec =',irec #ifdef NC_DOUBLE status=NF_GET_VARA_DOUBLE(ncidp,varidyu1,start,count,pyu12) #else status=NF_GET_VARA_REAL(ncidp,varidyu1,start,count,pyu12) #endif call gr_ecrit_fi(1,kon,iim,jjm+1,pyu12,pyu1) c pyv1 print*,'LECTURE de yv1 a irec =',irec #ifdef NC_DOUBLE status=NF_GET_VARA_DOUBLE(ncidp,varidyv1,start,count,pyv12) #else status=NF_GET_VARA_REAL(ncidp,varidyv1,start,count,pyv12) #endif call gr_ecrit_fi(1,kon,iim,jjm+1,pyv12,pyv1) c ftsol1 print*,'LECTURE de ftsol1 a irec =',irec #ifdef NC_DOUBLE status=NF_GET_VARA_DOUBLE(ncidp,varidfts1,start,count,ftsol12) #else status=NF_GET_VARA_REAL(ncidp,varidfts1,start,count,ftsol12) #endif call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol12,ftsol1) c ftsol2 print*,'LECTURE de ftsol2 a irec =',irec #ifdef NC_DOUBLE status=NF_GET_VARA_DOUBLE(ncidp,varidfts2,start,count,ftsol22) #else status=NF_GET_VARA_REAL(ncidp,varidfts2,start,count,ftsol22) #endif call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol22,ftsol2) c ftsol3 print*,'LECTURE de ftsol3 a irec =',irec #ifdef NC_DOUBLE status=NF_GET_VARA_DOUBLE(ncidp,varidfts3,start,count,ftsol32) #else status=NF_GET_VARA_REAL(ncidp,varidfts3,start,count,ftsol32) #endif call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol32,ftsol3) c ftsol4 #ifdef NC_DOUBLE status=NF_GET_VARA_DOUBLE(ncidp,varidfts4,start,count,ftsol42) #else status=NF_GET_VARA_REAL(ncidp,varidfts4,start,count,ftsol42) #endif call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol42,ftsol4) c psrf1 #ifdef NC_DOUBLE status=NF_GET_VARA_DOUBLE(ncidp,varidpsr1,start,count,psrf12) #else status=NF_GET_VARA_REAL(ncidp,varidpsr1,start,count,psrf12) #endif c call dump2d(iip1-1,jjm+1,psrf12,'PSRF1NC') call gr_ecrit_fi(1,kon,iim,jjm+1,psrf12,psrf1) c psrf2 #ifdef NC_DOUBLE status=NF_GET_VARA_DOUBLE(ncidp,varidpsr2,start,count,psrf22) #else status=NF_GET_VARA_REAL(ncidp,varidpsr2,start,count,psrf22) #endif c call dump2d(iip1-1,jjm+1,psrf22,'PSRF2NC') call gr_ecrit_fi(1,kon,iim,jjm+1,psrf22,psrf2) c psrf3 #ifdef NC_DOUBLE status=NF_GET_VARA_DOUBLE(ncidp,varidpsr3,start,count,psrf32) #else status=NF_GET_VARA_REAL(ncidp,varidpsr3,start,count,psrf32) #endif call gr_ecrit_fi(1,kon,iim,jjm+1,psrf32,psrf3) c psrf4 #ifdef NC_DOUBLE status=NF_GET_VARA_DOUBLE(ncidp,varidpsr4,start,count,psrf42) #else status=NF_GET_VARA_REAL(ncidp,varidpsr4,start,count,psrf42) #endif call gr_ecrit_fi(1,kon,iim,jjm+1,psrf42,psrf4) do i = 1,kon psrf(i,1) = psrf1(i) psrf(i,2) = psrf2(i) psrf(i,3) = psrf3(i) psrf(i,4) = psrf4(i) ftsol(i,1) = ftsol1(i) ftsol(i,2) = ftsol2(i) ftsol(i,3) = ftsol3(i) ftsol(i,4) = ftsol4(i) enddo endif return end