c c $Header$ c 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 status=NF_GET_VARA_REAL(ncidp,varidpl,1,kev,pl) 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 status=NF_GET_VARA_REAL(ncidp,varidps,start,count,phisfi2) call gr_ecrit_fi(1,kon,iim,jjm+1,phisfi2,phisfi) c aire status=NF_GET_VARA_REAL(ncidp,varidai,start,count,airefi2) 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 status=NF_GET_VARA_REAL(ncidp,varidfi,start,count,frac_impa2) call gr_ecrit_fi(kev,kon,iim,jjm+1,frac_impa2,frac_impa) c frac_nucl status=NF_GET_VARA_REAL(ncidp,varidfn,start,count,frac_nucl2) call gr_ecrit_fi(kev,kon,iim,jjm+1,frac_nucl2,frac_nucl) c abder t status=NF_GET_VARA_REAL(ncidp,varidt,start,count,t2) call gr_ecrit_fi(kev,kon,iim,jjm+1,t2,t) c mfu status=NF_GET_VARA_REAL(ncidp,varidmfu,start,count,mfu2) call gr_ecrit_fi(kev,kon,iim,jjm+1,mfu2,mfu) c mfd status=NF_GET_VARA_REAL(ncidp,varidmfd,start,count,mfd2) call gr_ecrit_fi(kev,kon,iim,jjm+1,mfd2,mfd) c en_u status=NF_GET_VARA_REAL(ncidp,varidenu,start,count,en_u2) call gr_ecrit_fi(kev,kon,iim,jjm+1,en_u2,en_u) c de_u status=NF_GET_VARA_REAL(ncidp,variddeu,start,count,de_u2) call gr_ecrit_fi(kev,kon,iim,jjm+1,de_u2,de_u) c en_d status=NF_GET_VARA_REAL(ncidp,varidend,start,count,en_d2) call gr_ecrit_fi(kev,kon,iim,jjm+1,en_d2,en_d) c de_d status=NF_GET_VARA_REAL(ncidp,varidded,start,count,de_d2) call gr_ecrit_fi(kev,kon,iim,jjm+1,de_d2,de_d) c coefh print*,'LECTURE de coefh a irec =',irec status=NF_GET_VARA_REAL(ncidp,varidch,start,count,coefh2) 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 status=NF_GET_VARA_REAL(ncidp,varidyu1,start,count,pyu12) call gr_ecrit_fi(1,kon,iim,jjm+1,pyu12,pyu1) c pyv1 print*,'LECTURE de yv1 a irec =',irec status=NF_GET_VARA_REAL(ncidp,varidyv1,start,count,pyv12) call gr_ecrit_fi(1,kon,iim,jjm+1,pyv12,pyv1) c ftsol1 print*,'LECTURE de ftsol1 a irec =',irec status=NF_GET_VARA_REAL(ncidp,varidfts1,start,count,ftsol12) call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol12,ftsol1) c ftsol2 print*,'LECTURE de ftsol2 a irec =',irec status=NF_GET_VARA_REAL(ncidp,varidfts2,start,count,ftsol22) call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol22,ftsol2) c ftsol3 print*,'LECTURE de ftsol3 a irec =',irec status=NF_GET_VARA_REAL(ncidp,varidfts3,start,count,ftsol32) call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol32,ftsol3) c ftsol4 status=NF_GET_VARA_REAL(ncidp,varidfts4,start,count,ftsol42) call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol42,ftsol4) c psrf1 status=NF_GET_VARA_REAL(ncidp,varidpsr1,start,count,psrf12) c call dump2d(iip1-1,jjm+1,psrf12,'PSRF1NC') call gr_ecrit_fi(1,kon,iim,jjm+1,psrf12,psrf1) c psrf2 status=NF_GET_VARA_REAL(ncidp,varidpsr2,start,count,psrf22) c call dump2d(iip1-1,jjm+1,psrf22,'PSRF2NC') call gr_ecrit_fi(1,kon,iim,jjm+1,psrf22,psrf2) c psrf3 status=NF_GET_VARA_REAL(ncidp,varidpsr3,start,count,psrf32) call gr_ecrit_fi(1,kon,iim,jjm+1,psrf32,psrf3) c psrf4 status=NF_GET_VARA_REAL(ncidp,varidpsr4,start,count,psrf42) 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