program create_netcdf IMPLICIT NONE INTEGER llm,nbt INTEGER llmf,nbtf,nbth INTEGER nbts INTEGER llmq,nbtq INTEGER llmw,nbtw INTEGER llmap,nbtap INTEGER lm,lh,nbstep ! llm, nbt: nb de niveaux et de pdt des champs moyens ! lh, nbth: nb de niveaux et de pdt des demi niveaux ! llmf, nbtf: nb de niveaux et de pdt des tendances ! nbts: nb de pdt des flux ! llmq, nbtq: nb de niveaux et de pdt de q1 et q2 ! lm,nbstep: dimensions du format netcdf ! llmw, nbtw: nb de niveaux et de pdt de uw et vw ! llmap, nbtap: nb de demi niveaux et de pdt (dans coord_a_b.txt) print*, 'Nombre de niveaux des champs moyens' read(5,*) llm print*, llm print*, 'nombre de pas de temps des champs moyens' read(5,*) nbt print*, nbt print*, 'Nombre de niveaux des advections' read(5,*) llmf print*, llmf print*, 'nombre de pas de temps des advections' read(5,*) nbtf print*, nbtf print*, 'nombre de pas de temps des flux' read(5,*) nbts print*, nbts print*, 'Nombre de niveaux des q1 q2' read(5,*) llmq print*, llmq print*, 'nombre de pas de temps des q1 q2' read(5,*) nbtq print*, nbtq print*, 'Nombre de niveaux des uw vw' read(5,*) llmw print*, llmw print*, 'nombre de pas de temps des uw vw' read(5,*) nbtw print*, nbtw print*, 'Nombre de niveaux des ap bp' read(5,*) llmap print*, llmap print*, 'nombre de pas de temps des ap bp' read(5,*) nbtap print*, nbtap lm=max(llm,llmf) lh=lm+1 nbth=1 print*,lm nbstep=max(nbt,nbtf,nbts) print*,nbstep CALL create_netcdf_sub(llm,nbt,llmf,nbtap,llmap,nbtf,nbts,llmq,nbtq,llmw,nbtw,lm,lh,nbstep,nbth) END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SUBROUTINE create_netcdf_sub(llm,nbt,llmf,nbtap,llmap,nbtf,nbts,llmq,nbtq,llmw,nbtw,lm,lh,nbstep,nbth) IMPLICIT NONE include "netcdf.inc" include "YOMCST.h" include "YOETHF.h" EXTERNAL suphel !Dimensions !Fichiers etats moyens: llm, nbt !Fichiers forçages: llmf, nbtf !Fichiers flux de surface: nbts !Fichiers de sortie: lm,nbstep INTEGER llm,lh,nbt INTEGER llmf,nbtf,nbth INTEGER nbts INTEGER llmq,nbtq INTEGER llmw,nbtw INTEGER llmap,nbtap INTEGER lm,lmh,nbstep INTEGER l,k INTEGER xm,ym PARAMETER(xm=1,ym=1) !Variables lues !Dates REAL*8 year(nbt),month(nbt),day(nbt) REAL*8 hour(nbt),time(nbt) REAL*8 yearf(nbtf),monthf(nbtf),dayf(nbtf) REAL*8 hourf(nbtf),timef(nbtf) REAL*8 years(nbts),months(nbts),days(nbts) REAL*8 hours(nbts),times(nbts) REAL*8 yearq(nbtq),monthq(nbtq),dayq(nbtq) REAL*8 hourq(nbtq),timeq(nbtq) REAL*8 yearw(nbtq),monthw(nbtq),dayw(nbtq) REAL*8 hourw(nbtq),timew(nbtq) REAL*8 time_out(nbstep) REAL*8 time_out_min,time_out_max !Définition lon, lat REAL*8 lon(xm),lat(ym) !niveaux verticaux REAL*8 zz(llm,nbt),zzf(llmf,nbtf),zlev(lm,nbstep) !profils moyens lus REAL*8 th(llm,nbt),mwr(llm,nbt),u(llm,nbt),v(llm,nbt) REAL*8 pp(llm,nbt),qv(llm,nbt),T(llm,nbt),rh(llm,nbt) !flux de surface lus REAL*8 flxs(nbts),flxl(nbts),ts(nbts),ps(nbts),ust(nbts),orog !forcages grande echelle lus REAL*8 ppf(llmf,nbtf) REAL*8 ug(llmf,nbtf),vg(llmf,nbtf),w(llmf,nbtf),omega(llmf,nbtf) REAL*8 du(llmf,nbtf),hu(llmf,nbtf),vu(llmf,nbtf) REAL*8 dv(llmf,nbtf),hv(llmf,nbtf),vv(llmf,nbtf) REAL*8 dT(llmf,nbtf),hT(llmf,nbtf),vT(llmf,nbtf),dtrad(llmf,nbtf) REAL*8 dq(llmf,nbtf),hq(llmf,nbtf),vq(llmf,nbtf) REAL*8 dth(llmf,nbtf),hth(llmf,nbtf),vth(llmf,nbtf) REAL*8 dr(llmf,nbtf),hr(llmf,nbtf),vr(llmf,nbtf) !q1 q2 lus REAL*8 ppq(llmq,nbtq) REAL*8 qq1(llmq,nbtq),qq2(llmq,nbtq) !uw vw lus REAL*8 ppw(llmw,nbtw) REAL*8 uuw(llmw,nbtw),vvw(llmw,nbtw) ! ap,bp,pres_h lus REAL*8 ppp_h(llmap,nbtap),aap_h(llmap,nbtap),bbp_h(llmap,nbtap) !Paramètres de forçages INTEGER tend_u,tend_v,tend_w,tend_t,tend_q INTEGER nudg_u,nudg_v,nudg_w,nudg_t,nudg_q REAL*8 XLVTT PARAMETER(XLVTT=2.5008E+6) !Variables intermédaires REAL*8 ppf_tmpv(lm,nbtf) REAL*8 ug_tmpv(lm,nbtf),vg_tmpv(lm,nbtf),w_tmpv(lm,nbtf),omega_tmpv(lm,nbtf) REAL*8 du_tmpv(lm,nbtf),hu_tmpv(lm,nbtf),vu_tmpv(lm,nbtf) REAL*8 dv_tmpv(lm,nbtf),hv_tmpv(lm,nbtf),vv_tmpv(lm,nbtf) REAL*8 dT_tmpv(lm,nbtf),hT_tmpv(lm,nbtf),vT_tmpv(lm,nbtf) REAL*8 dtrad_tmpv(lm,nbtf) REAL*8 dq_tmpv(lm,nbtf),hq_tmpv(lm,nbtf),vq_tmpv(lm,nbtf) REAL*8 dth_tmpv(lm,nbtf),hth_tmpv(lm,nbtf),vth_tmpv(lm,nbtf) REAL*8 dr_tmpv(lm,nbtf),hr_tmpv(lm,nbtf),vr_tmpv(lm,nbtf) REAL*8 th_tmpv(lm,nbt),mwr_tmpv(lm,nbt),u_tmpv(lm,nbt),v_tmpv(lm,nbt) REAL*8 pp_tmpv(lm,nbt),qv_tmpv(lm,nbt),T_tmpv(lm,nbt),rh_tmpv(lm,nbt) REAL*8 ppq_tmpv(lm,nbtq),q1_tmpv(lm,nbtq),q2_tmpv(lm,nbtq) REAL*8 ppw_tmpv(lm,nbtw),uw_tmpv(lm,nbtw),vw_tmpv(lm,nbtw) REAL*8 pph_tmpv(lh,nbth),ap_tmpv(lh,nbth),bp_tmpv(lh,nbth) REAL*8 zz_tmpv(lm,nbt),zzf_tmpv(lm,nbtf) !Variables ecrites dans fichier netcdf aux dimensions lm,nbstep !profils moyen REAL*8 vitu(lm,nbstep),vitv(lm,nbstep) REAL*8 pres(lm,nbstep),ovap(lm,nbstep),temp(lm,nbstep),rhum(lm,nbstep) REAL*8 theta(lm,nbstep),rvv(lm,nbstep) !flux de surface REAL*8 flat(nbstep),sens(nbstep),tsurf(nbstep),psurf(nbstep),ustar(nbstep) !forcages grande echelle REAL*8 vitug(lm,nbstep),vitvg(lm,nbstep),vitw(lm,nbstep),omeg(lm,nbstep) REAL*8 advT(lm,nbstep),T_advh(lm,nbstep),T_advv(lm,nbstep) REAL*8 radT(lm,nbstep) REAL*8 advq(lm,nbstep),q_advh(lm,nbstep),q_advv(lm,nbstep) REAL*8 advth(lm,nbstep),th_advh(lm,nbstep),th_advv(lm,nbstep) REAL*8 advr(lm,nbstep),r_advh(lm,nbstep),r_advv(lm,nbstep) REAL*8 advu(lm,nbstep),u_advh(lm,nbstep),u_advv(lm,nbstep) REAL*8 advv(lm,nbstep),v_advh(lm,nbstep),v_advv(lm,nbstep) REAL*8 q1(lm,nbstep),q2(lm,nbstep) REAL*8 uw(lm,nbstep),vw(lm,nbstep) REAL*8 ph(lh,nbstep),ap(lh,nbstep),bp(lh,nbstep) REAL*8 timestep,dtm,dtf,dts REAL*8 day_init,month_init REAL*8 dayf_init,monthf_init REAL*8 days_init,months_init REAL*8 dayq_init,monthq_init REAL*8 dayw_init,monthw_init INTEGER nday,ndayf,ndays,ndayq,ndayw !Définition des sorties integer nbvar3d_out parameter (nbvar3d_out=50) character (len=50), dimension(nbvar3d_out) :: varname3d_out integer ierr integer :: londimout,latdimout integer :: altdimout,altdimouth,timedimout !,timevarout integer :: nout integer var3didout(50),toto(lm) character*4 poub real*8 ppp(lm),ppph(lh) CALL suphel ! Read in data ! read initial profiles open(10,file='profil_moy.txt') ! Combien de profils d environnement ? read(10,*),nbt ! Combien de niveaux ? read(10,*),llm print *,'nbt,llm=',nbt,llm do l=1,nbt read (10,*) year(l),month(l),day(l),hour(l) do k=1,llm read(10,*) pp(k,l),zz(k,l),u(k,l),v(k,l),T(k,l),th(k,l),qv(k,l),mwr(k,l),rh(k,l) enddo enddo close(10) !read pressure coordinates ap,bp,pph !----------------------------------- open(15,file='coord_a_b.txt') read(15,*),nbtap read(15,*),llmap print *,'llmap',llmap do l=1,nbtap do k=1,llmap read (15,*) aap_h(k,l),bbp_h(k,l),ppp_h(k,l) print *,'aap,bbp,ppp',k, aap_h(k,1),bbp_h(k,1),ppp_h(k,1) enddo enddo close(15) !read tendencies !------------------------------- ! TEND A B C D E ! A=1 on utilise tendances sur U ! B=1 on utilise tendances sur V ! C=1 on utilise tendances sur W ! D=1 on utilise tendances sur theta ! E=1 on utilise tendances sur vapeur eau !------------------------------- ! NUDG A B C D E ! A= U est nudge avec un temps de relaxation de A ! B= V est nudge avec un temps de relaxation de B ! C= W est nudge avec un temps de relaxation de C ! D= theta est nudge avec un temps de relaxation de D ! E= vapeur d'eau est nudgee avec un temps de relaxation de E ! si A,B,C,D,E=0 => pas de nudging ! si A,B=-1 => nudging avec vent geostrophique fourni !------------------------------- open(11,file='profil_adv.txt') ! Lecture des flags de tendances ! read(11,*),poub,tend_u,tend_v,tend_w,tend_t,tend_q ! IF (poub.NE.'TEND') stop 'Erreur fichier profil_tend.txt ! manque TEND' ! Lecture des flags de nudging ! read(11,*),poub,nudg_u,nudg_v,nudg_w,nudg_t,nudg_q ! IF (poub.NE.'NUDG') stop 'Erreur fichier profil_tend.txt ! manque NUDG' ! Combien de profils de forcing ? read(11,*),nbtf ! Combien de niveaux ? read(11,*),llmf ! Lecture des profils do l=1,nbtf read (11,*) yearf(l),monthf(l),dayf(l),hourf(l) do k=1,llmf read(11,*) ppf(k,l),zzf(k,l),ug(k,l),vg(k,l),w(k,l),omega(k,l),du(k,l),hu(k,l),vu(k,l) & & ,dv(k,l),hv(k,l),vv(k,l),dT(k,l),hT(k,l),vT(k,l),dtrad(k,l),dq(k,l) & & ,hq(k,l),vq(k,l),dth(k,l),hth(k,l),vth(k,l),dr(k,l),hr(k,l),vr(k,l) enddo enddo close(11) !Lecture des flux open(12,file='time_flux.txt') ! Combien de flux? read(12,*),nbts do l=1,nbts read(12,*) years(l),months(l),days(l),hours(l),flxs(l),flxl(l),ts(l),ust(l),ps(l),orog print *,'flux=', l,years(l),months(l),days(l),hours(l),flxs(l),flxl(l) enddo close(12) ! read Q1, Q2 open(13,file='q1_q2.txt') ! Combien de profils de q1 q2 ? read(13,*),nbtq ! Combien de niveaux ? read(13,*),llmq do l=1,nbtq read (13,*) yearq(l),monthq(l),dayq(l),hourq(l) do k=1,llmq read(13,*) ppq(k,l),qq1(k,l),qq2(k,l) enddo enddo close(13) ! read uw, vw open(14,file='uw_vw.txt') ! Combien de profils de uw vw ? read(14,*),nbtw ! Combien de niveaux ? read(14,*),llmw do l=1,nbtw read (14,*) yearw(l),monthw(l),dayw(l),hourw(l) do k=1,llmw read(14,*) ppw(k,l),uuw(k,l),vvw(k,l) enddo enddo close(14) !------------------------------------------------------------------ ! Modifier le call def_var pour avoir date correcte (ligne 1530) !------------------------------------------------------------------ !définition lon,lat: arm_cu lon(1)=-97.5 lat(1)=35.8 !définition lon,lat: Rico ! lon(1)=-149 ! lat(1)=18.49 !définition lon,lat: Bomex ! lon(1)=-56.5 ! lat(1)=15.0 !définition lon,lat: Cindy ! lon(1)=73.15 ! lat(1)=-0.69 !AMMA ! lon(1)=2.18 ! lat(1)=13.47 !IHOP ! lon(1)=-100.61 ! lat(1)=36.56 !definition des axes des temps en secondes a partir du debut du cas time(1)=hour(1) print *,'time(1)=',time(1) day_init=day(1) month_init=month(1) nday=1 if (nbt.gt.1) then do l=2,nbt if (day(l).ne.day(l-1)) then nday=nday+1 endif time(l)=hour(l)+(nday-1)*24.*3600. ! print *,'1 l time=',l,month(l),day(l),hour(l),time(l) enddo dtm=time(2)-time(1) else dtm=0. endif print*,"dtm=",dtm timef(1)=hourf(1) print *,'timef(1)=',timef(1) dayf_init=dayf(1) monthf_init=monthf(1) ndayf=1 do l=2,nbtf if (dayf(l).ne.dayf(l-1)) then ndayf=ndayf+1 endif timef(l)=hourf(l)+(ndayf-1)*24.*3600. ! print *,'1 l timef=',l,monthf(l),dayf(l),hourf(l),timef(l) enddo dtf=timef(2)-timef(1) print*,"dtf=",dtf times(1)=hours(1) print *,'times(1)=',times(1) days_init=days(1) months_init=months(1) ndays=1 do l=2,nbts if (days(l).ne.days(l-1)) then ndays=ndays+1 endif times(l)=hours(l)+(ndays-1)*24.*3600. ! print *,'1 l time=',l,months(l),days(l),hours(l),times(l) enddo dts=times(2)-times(1) print*,"dts=",dts timeq(1)=hourq(1) print *,'timeq(1)=',timeq(1) dayq_init=dayq(1) monthq_init=monthq(1) ndayq=1 do l=2,nbtq if (dayq(l).ne.dayq(l-1)) then ndayq=ndayq+1 endif timeq(l)=hourq(l)+(ndayq-1)*24.*3600. ! print *,'1 l time=',l,monthq(l),dayq(l),hourq(l),timeq(l) enddo timew(1)=hourw(1) print *,'timew(1)=',timew(1) dayw_init=dayw(1) monthw_init=monthw(1) ndayw=1 do l=2,nbtw if (dayw(l).ne.dayw(l-1)) then ndayw=ndayw+1 endif timew(l)=hourw(l)+(ndayw-1)*24.*3600. ! print *,'1 l time=',l,monthw(l),dayw(l),hourw(l),timew(l) enddo !Choix d'une grille verticale et temporelle unique !On prend la resolution la plus fine !Interpolation sur la meme grille verticale si necessaire if (llm.ne.llmf) then if (llm.gt.llmf) then print *,'llm > llmf' call interp_vertical(llmf,nbtf,lm,pp,ppf,zzf,zzf_tmpv) call interp_vertical(llmf,nbtf,lm,pp,ppf,ppf,ppf_tmpv) call interp_vertical(llmf,nbtf,lm,pp,ppf,ug,ug_tmpv) call interp_vertical(llmf,nbtf,lm,pp,ppf,vg,vg_tmpv) call interp_vertical(llmf,nbtf,lm,pp,ppf,w,w_tmpv) call interp_vertical(llmf,nbtf,lm,pp,ppf,omega,omega_tmpv) call interp_vertical(llmf,nbtf,lm,pp,ppf,du,du_tmpv) call interp_vertical(llmf,nbtf,lm,pp,ppf,hu,hu_tmpv) call interp_vertical(llmf,nbtf,lm,pp,ppf,vu,vu_tmpv) call interp_vertical(llmf,nbtf,lm,pp,ppf,dv,dv_tmpv) call interp_vertical(llmf,nbtf,lm,pp,ppf,hv,hv_tmpv) call interp_vertical(llmf,nbtf,lm,pp,ppf,vv,vv_tmpv) call interp_vertical(llmf,nbtf,lm,pp,ppf,dT,dT_tmpv) call interp_vertical(llmf,nbtf,lm,pp,ppf,hT,hT_tmpv) call interp_vertical(llmf,nbtf,lm,pp,ppf,vT,vT_tmpv) call interp_vertical(llmf,nbtf,lm,pp,ppf,dtrad,dtrad_tmpv) call interp_vertical(llmf,nbtf,lm,pp,ppf,dq,dq_tmpv) call interp_vertical(llmf,nbtf,lm,pp,ppf,hq,hq_tmpv) call interp_vertical(llmf,nbtf,lm,pp,ppf,vq,vq_tmpv) call interp_vertical(llmf,nbtf,lm,pp,ppf,dth,dth_tmpv) call interp_vertical(llmf,nbtf,lm,pp,ppf,hth,hth_tmpv) call interp_vertical(llmf,nbtf,lm,pp,ppf,vth,vth_tmpv) call interp_vertical(llmf,nbtf,lm,pp,ppf,dr,dr_tmpv) call interp_vertical(llmf,nbtf,lm,pp,ppf,hr,hr_tmpv) call interp_vertical(llmf,nbtf,lm,pp,ppf,vr,vr_tmpv) do l=1,nbt do k=1,lm zz_tmpv(k,l)=zz(k,l) u_tmpv(k,l)=u(k,l) v_tmpv(k,l)=v(k,l) T_tmpv(k,l)=T(k,l) th_tmpv(k,l)=th(k,l) mwr_tmpv(k,l)=mwr(k,l) qv_tmpv(k,l)=qv(k,l) rh_tmpv(k,l)=rh(k,l) enddo enddo else if (llmf.gt.llm) then print *,'llmf > llm' call interp_vertical(llm,nbt,lm,ppf,pp,zz,zz_tmpv) call interp_vertical(llm,nbt,lm,ppf,pp,u,u_tmpv) call interp_vertical(llm,nbt,lm,ppf,pp,v,v_tmpv) call interp_vertical(llm,nbt,lm,ppf,pp,T,T_tmpv) call interp_vertical(llm,nbt,lm,ppf,pp,th,th_tmpv) call interp_vertical(llm,nbt,lm,ppf,pp,mwr,mwr_tmpv) call interp_vertical(llm,nbt,lm,ppf,pp,qv,qv_tmpv) call interp_vertical(llm,nbt,lm,ppf,pp,rh,rh_tmpv) do l=1,nbtf do k=1,lm zzf_tmpv(k,l)=zzf(k,l) ppf_tmpv(k,l)=ppf(k,l) ug_tmpv(k,l)=ug(k,l) vg_tmpv(k,l)=vg(k,l) w_tmpv(k,l)=w(k,l) omega_tmpv(k,l)=omega(k,l) du_tmpv(k,l)=du(k,l) hu_tmpv(k,l)=hu(k,l) vu_tmpv(k,l)=vu(k,l) dv_tmpv(k,l)=dv(k,l) hv_tmpv(k,l)=hv(k,l) vv_tmpv(k,l)=vv(k,l) dT_tmpv(k,l)=dT(k,l) hT_tmpv(k,l)=hT(k,l) vT_tmpv(k,l)=vT(k,l) dtrad_tmpv(k,l)=dtrad(k,l) dq_tmpv(k,l)=dq(k,l) hq_tmpv(k,l)=hq(k,l) vq_tmpv(k,l)=vq(k,l) dth_tmpv(k,l)=dth(k,l) hth_tmpv(k,l)=hth(k,l) vth_tmpv(k,l)=vth(k,l) dr_tmpv(k,l)=dr(k,l) hr_tmpv(k,l)=hr(k,l) vr_tmpv(k,l)=vr(k,l) enddo enddo endif else print *,'llm = llmf' ! rappel: lm= max (llm,llmf) do l=1,nbt do k=1,lm zz_tmpv(k,l)=zz(k,l) pp_tmpv(k,l)=pp(k,l) u_tmpv(k,l)=u(k,l) v_tmpv(k,l)=v(k,l) T_tmpv(k,l)=T(k,l) th_tmpv(k,l)=th(k,l) mwr_tmpv(k,l)=mwr(k,l) qv_tmpv(k,l)=qv(k,l) rh_tmpv(k,l)=rh(k,l) enddo enddo do l=1,nbtf do k=1,lm zzf_tmpv(k,l)=zzf(k,l) ppf_tmpv(k,l)=ppf(k,l) ug_tmpv(k,l)=ug(k,l) vg_tmpv(k,l)=vg(k,l) w_tmpv(k,l)=w(k,l) omega_tmpv(k,l)=omega(k,l) du_tmpv(k,l)=du(k,l) hu_tmpv(k,l)=hu(k,l) vu_tmpv(k,l)=vu(k,l) dv_tmpv(k,l)=dv(k,l) hv_tmpv(k,l)=hv(k,l) vv_tmpv(k,l)=vv(k,l) dT_tmpv(k,l)=dT(k,l) hT_tmpv(k,l)=hT(k,l) vT_tmpv(k,l)=vT(k,l) dtrad_tmpv(k,l)=dtrad(k,l) dq_tmpv(k,l)=dq(k,l) hq_tmpv(k,l)=hq(k,l) vq_tmpv(k,l)=vq(k,l) dth_tmpv(k,l)=dth(k,l) hth_tmpv(k,l)=hth(k,l) vth_tmpv(k,l)=vth(k,l) dr_tmpv(k,l)=dr(k,l) hr_tmpv(k,l)=hr(k,l) vr_tmpv(k,l)=vr(k,l) enddo enddo print*,'pas d interpolation verticale' endif if (llm.ne.llmq) then call interp_vertical(llmq,nbtq,lm,pp,ppq,ppq,ppq_tmpv) call interp_vertical(llmq,nbtq,lm,pp,ppq,qq1,q1_tmpv) call interp_vertical(llmq,nbtq,lm,pp,ppq,qq2,q2_tmpv) else do l=1,nbtq do k=1,lm ppq_tmpv(k,l)=ppq(k,l) q1_tmpv(k,l)=qq1(k,l) q2_tmpv(k,l)=qq2(k,l) enddo enddo endif if (llm.ne.llmw) then call interp_vertical(llmw,nbtw,lm,pp,ppw,ppw,ppw_tmpv) call interp_vertical(llmw,nbtw,lm,pp,ppw,uuw,uw_tmpv) call interp_vertical(llmw,nbtw,lm,pp,ppw,vvw,vw_tmpv) else do l=1,nbtw do k=1,lm ppw_tmpv(k,l)=ppw(k,l) uw_tmpv(k,l)=uuw(k,l) vw_tmpv(k,l)=vvw(k,l) enddo enddo endif if (lh.ne.llmap) then print *,'on passe dans interp_vertical pour pph' call interp_vertical(llmap,nbtap,lh,pp,ppp_h,ppp_h,pph_tmpv) call interp_vertical(llmap,nbtap,lh,pp,ppp_h,aap_h,ap_tmpv) call interp_vertical(llmap,nbtap,lh,pp,ppp_h,bbp_h,bp_tmpv) else do l=1,nbth do k=1,lh pph_tmpv(k,l)=ppp_h(k,l) ap_tmpv(k,l)=aap_h(k,l) bp_tmpv(k,l)=bbp_h(k,l) enddo enddo endif print*, 'apres interpolation verticale ap,bp' !Interpolation en temps si necessaire time_out_min=min(time(1),timef(1),times(1)) ! print*, time_out_min time_out_max=max(time(nbt),timef(nbtf),times(nbts)) ! print*, time_out_max if (dtm.eq.0.) then timestep=min(dtf,dts) else timestep=min(dtm,dtf,dts) endif print*, 'timestep=',timestep ! nbstep=int((time_out_max-time_out_min)/timestep) ! print*, nbstep ! time_out(1)=time(1) time_out(1)=time_out_min ! print*, time_out(1) ! time_out(nbstep)=timef(nbtf) time_out(nbstep)=time_out_max ! print*, time_out(nbstep) do l=2,nbstep-1 time_out(l)=time_out(1)+(l-1)*timestep ! print*, time_out(l) enddo do l=1,nbstep ! print*,'time_out',time_out(l) enddo print*, 'apres calcul time' if (nbstep.ne.nbt) then call interp_time(lm,nbt,nbstep,dtm,time,time_out,pp_tmpv,pres) call interp_time(lm,nbt,nbstep,dtm,time,time_out,zz_tmpv,zlev) call interp_time(lm,nbt,nbstep,dtm,time,time_out,u_tmpv,vitu) call interp_time(lm,nbt,nbstep,dtm,time,time_out,v_tmpv,vitv) call interp_time(lm,nbt,nbstep,dtm,time,time_out,T_tmpv,temp) call interp_time(lm,nbt,nbstep,dtm,time,time_out,th_tmpv,theta) call interp_time(lm,nbt,nbstep,dtm,time,time_out,mwr_tmpv,rvv) call interp_time(lm,nbt,nbstep,dtm,time,time_out,qv_tmpv,ovap) call interp_time(lm,nbt,nbstep,dtm,time,time_out,rh_tmpv,rhum) ! do l=1,nbt ! do k=1,lm ! print*,'T avant',l,k,T_tmpv(k,l) ! enddo ! enddo ! do l=1,nbstep ! do k=1,lm ! print*,'T apres',l,k,temp(k,l) ! enddo ! enddo else do l=1,nbstep do k=1,lm pres(k,l)=pp_tmpv(k,l) zlev(k,l)=zz_tmpv(k,l) vitu(k,l)=u_tmpv(k,l) vitv(k,l)=v_tmpv(k,l) temp(k,l)=T_tmpv(k,l) theta(k,l)=th_tmpv(k,l) rvv(k,l)=mwr_tmpv(k,l) ovap(k,l)=qv_tmpv(k,l) rhum(k,l)=rh_tmpv(k,l) enddo enddo endif print*, 'apres interpolation champs moyens' if (nbstep.ne.nbtf) then ! do l=1,nbtf ! do k=1,lm ! print*,'avant interpolation ppf_tmpv',l,k,ppf_tmpv(k,l) ! enddo ! enddo call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,ppf_tmpv,pres) ! do l=1,nbstep ! do k=1,lm ! print*,'apres interpolation pres',l,k,pres(k,l) ! enddo ! enddo call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,zzf_tmpv,zlev) call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,ug_tmpv,vitug) call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,vg_tmpv,vitvg) call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,w_tmpv,vitw) call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,omega_tmpv,omeg) call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,du_tmpv,advu) call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,hu_tmpv,u_advh) call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,vu_tmpv,u_advv) call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,dv_tmpv,advv) call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,hv_tmpv,v_advh) call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,vv_tmpv,v_advv) call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,dT_tmpv,advT) call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,hT_tmpv,T_advh) call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,vT_tmpv,T_advv) call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,dtrad_tmpv,radT) call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,dq_tmpv,advq) call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,hq_tmpv,q_advh) call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,vq_tmpv,q_advv) call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,dth_tmpv,advth) call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,hth_tmpv,th_advh) call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,vth_tmpv,th_advv) call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,dr_tmpv,advr) call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,hr_tmpv,r_advh) call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,vr_tmpv,r_advv) else do l=1,nbstep do k=1,lm pres(k,l)=ppf_tmpv(k,l) zlev(k,l)=zzf_tmpv(k,l) vitug(k,l)=ug_tmpv(k,l) vitvg(k,l)=vg_tmpv(k,l) vitw(k,l)=w_tmpv(k,l) omeg(k,l)=omega_tmpv(k,l) advu(k,l)=du_tmpv(k,l) u_advh(k,l)=hu_tmpv(k,l) u_advv(k,l)=vu_tmpv(k,l) advv(k,l)=dv_tmpv(k,l) v_advh(k,l)=hv_tmpv(k,l) v_advv(k,l)=vv_tmpv(k,l) advT(k,l)=dT_tmpv(k,l) T_advh(k,l)=hT_tmpv(k,l) T_advv(k,l)=vT_tmpv(k,l) radT(k,l)=dtrad_tmpv(k,l) advq(k,l)=dq_tmpv(k,l) q_advh(k,l)=hq_tmpv(k,l) q_advv(k,l)=vq_tmpv(k,l) advth(k,l)=dth_tmpv(k,l) th_advh(k,l)=hth_tmpv(k,l) th_advv(k,l)=vth_tmpv(k,l) advr(k,l)=dr_tmpv(k,l) r_advh(k,l)=hr_tmpv(k,l) r_advv(k,l)=vr_tmpv(k,l) enddo enddo endif print*, 'apres interpolation forcages' if (nbstep.ne.nbts) then call interp_time(1,nbts,nbstep,timestep,times,time_out,flxs,sens) call interp_time(1,nbts,nbstep,timestep,times,time_out,flxl,flat) call interp_time(1,nbts,nbstep,timestep,times,time_out,ts,tsurf) call interp_time(1,nbts,nbstep,timestep,times,time_out,ps,psurf) call interp_time(1,nbts,nbstep,timestep,times,time_out,ust,ustar) else do l=1,nbstep sens(l)=flxs(l) flat(l)=flxl(l) tsurf(l)=ts(l) psurf(l)=ps(l) ustar(l)=ust(l) enddo endif print*, 'apres interpolation flux' if (nbstep.ne.nbtq) then call interp_time(lm,nbtq,nbstep,dtm,timeq,time_out,ppq_tmpv,pres) call interp_time(lm,nbtq,nbstep,dtm,timeq,time_out,q1_tmpv,q1) call interp_time(lm,nbtq,nbstep,dtm,timeq,time_out,q2_tmpv,q2) else do l=1,nbstep do k=1,lm pres(k,l)=ppq_tmpv(k,l) q1(k,l)=q1_tmpv(k,l) q2(k,l)=q2_tmpv(k,l) enddo enddo endif print*, 'apres interpolation q1,q2' if (nbstep.ne.nbtw) then call interp_time(lm,nbtw,nbstep,dtm,timew,time_out,ppw_tmpv,pres) call interp_time(lm,nbtw,nbstep,dtm,timew,time_out,uw_tmpv,uw) call interp_time(lm,nbtw,nbstep,dtm,timew,time_out,vw_tmpv,vw) else do l=1,nbstep do k=1,lm pres(k,l)=ppw_tmpv(k,l) uw(k,l)=uw_tmpv(k,l) vw(k,l)=vw_tmpv(k,l) enddo enddo endif print*, 'apres interpolation uw,vw' do l=1,nbstep do k=1,lh ph(k,l)=pph_tmpv(k,l) ap(k,l)=ap_tmpv(k,l) bp(k,l)=bp_tmpv(k,l) enddo enddo print*, 'apres interpolation ap,bp,pp' !ecriture des resultats dans un fichier nc ! ppp=reference en altitude pour les niveaux pleins (pres ou zlev) ! ppph=reference en altitude pour les demi-niveaux (pp_h ou altitude) print*,'avant ecriture ok',nbstep,lm do k=1,lm ! ppp(k)=pres(k,1) ! on indice les donnees en pression ppp(k)=zlev(k,1) ! on indice les donnees en hauteur print *,'pres_h,zlev,pres_f=',pp(k,1),ppp(k),pres(k,1) enddo ! do k=1,lm ! pression aux demi-niveaux ! ppph(k)=pp_h(k) ! enddo ! calcul de la hauteur au demi niveaux ! ppph(1)=orog-((temp(1,1)+ts(1))/2.*RD*(pres(1,1)-pp_h(1)))/((pp_h(1)+pres(1,1))/2.*RG) ppph(1)=orog do k=2,lm ppph(k)=zlev(k,1)+((zlev(k,1)-zlev(k-1,1))*(ph(k,1)-pres(k,1)))/(pres(k,1)-pres(k-1,1)) ! print *,'k,temp,pres_f,pres_h,zlev_f,zlev_h=',k,temp(k,1),pres(k,1),pp(k,1),ppp(k),ppph(k) print *,'k,zk,zkm1,ppk,presk,preskm1=',k,zlev(k,1),zlev(k-1,1),pp(k,1),pres(k,1),pres(k-1,1) enddo !------------------from phys_output_write_mod.F90 ! zx_tmp_fi3d(:,1)= pphis(:)/RG ! DO k = 2, klev ! zx_tmp_fi3d(i,k) = zphi(i,k)/RG + (zphi(i,k)-zphi(i,k-1))/RG * (paprs(i,k)-pplay(i,k))/(pplay(i,k)-pplay(i,k-1)) ! paprs=demi niveau -> ici pp, pplay=niveau full -> ici pres ! ENDDO !--------------- call initiate ("cas.nc",lon,lat,ppp,ppph,time_out,& londimout,latdimout,altdimout,altdimouth,timedimout,nbstep,lm,lh,ym,xm) print*,'apres initiate: lon,lat,nbt=',lon,lat,nbt ! print*,'==============' ! RICO case: initial profile is made of T,qv,u,v ! so these variables are given only once call def_var(nout,"height_f","Height","m","up",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(1),ierr) call def_var(nout,"pressure_f","Pressure","Pa","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(2),ierr) call def_var(nout,"temp","Temperature","K","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(3),ierr) call def_var(nout,"qv","specific vapor humidity","kg/kg","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(4),ierr) call def_var(nout,"rh","Relative humidity","","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(5),ierr) call def_var(nout,"theta","Potential temperature","K","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(6),ierr) call def_var(nout,"rv","rv","kg/kg","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(7),ierr) call def_var(nout,"u","Zonal wind","m/s","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(8),ierr) call def_var(nout,"v","Meridional wind","m/s","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(9),ierr) call def_var(nout,"ug","Zonal geostrophic wind","m/s","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(10),ierr) call def_var(nout,"vg","Meridional geostrophic wind","m/s","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(11),ierr) call def_var(nout,"w","Vertical wind","m/s","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(12),ierr) call def_var(nout,"uadv","Large scale total adv. of u","m/s","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(13),ierr) call def_var(nout,"uadvh","Large scale horiz. adv. of u","m/s","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(14),ierr) call def_var(nout,"uadvv","Large scale vert. adv. of u","m/s","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(15),ierr) call def_var(nout,"vadv","Large scale total adv. of v","m/s","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(16),ierr) call def_var(nout,"vadvh","Large scale horiz. adv. of v","m/s","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(17),ierr) call def_var(nout,"vadvv","Large scale vert. adv. of v","m/s","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(18),ierr) call def_var(nout,"tadv","Large scale total adv. of temp","K/s","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(19),ierr) call def_var(nout,"tadvh","Large scale horiz. adv. of temp","K/s","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(20),ierr) call def_var(nout,"tadvv","Large scale vert. adv. of temp","K/s","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(21),ierr) call def_var(nout,"qadv","Large scale total adv. of q","kg/kg/s","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(22),ierr) call def_var(nout,"qadvh","Large scale horiz. adv. of q","kg/kg/s","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(23),ierr) call def_var(nout,"qadvv","Large scale vert. adv. of q","kg/kg/s","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(24),ierr) call def_var(nout,"thadv","Large scale total adv. of theta","K/s","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(25),ierr) call def_var(nout,"thadvh","Large scale horiz. adv. of theta","K/s","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(26),ierr) call def_var(nout,"thadvv","Large scale vert. adv. of theta","K/s","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(27),ierr) call def_var(nout,"radv","Large scale total adv. mix.ratio","kg/kg/s","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(28),ierr) call def_var(nout,"radvh","Large scale horiz. adv. mix.ratio","kg/kg/s","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(29),ierr) call def_var(nout,"radvv","Large scale vert. adv. mix.ratio","kg/kg/s","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(30),ierr) call def_var(nout,"radcool","Radiative cooling","K/s","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(31),ierr) call def_var(nout,"sfc_sens_flx","Sensible heat flux","W/m2","",3,(/londimout,latdimout,timedimout/),& &var3didout(32),ierr) call def_var(nout,"sfc_lat_flx","Latent heat flux","W/m2","",3,(/londimout,latdimout,timedimout/),& &var3didout(33),ierr) call def_var(nout,"ts","Surface temperature","K","",3,(/londimout,latdimout,timedimout/),& &var3didout(34),ierr) call def_var(nout,"ustar","Friction velocity","m/s","",3,(/londimout,latdimout,timedimout/),& &var3didout(35),ierr) call def_var(nout,"q1","Heating rate","K/day","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(36),ierr) call def_var(nout,"q2","Moisture rate","K/day","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(37),ierr) call def_var(nout,"ustress","U momentum flux","m2/s2","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(38),ierr) call def_var(nout,"vstress","V momentum flux","m2/s2","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(39),ierr) call def_var(nout,"ps","Surface pressure","Pa","",3,(/londimout,latdimout,timedimout/),& &var3didout(40),ierr) call def_var(nout,"omega","Vertical wind","Pa/s","",4,(/londimout,latdimout,altdimout,timedimout/),& &var3didout(41),ierr) call def_var(nout,"orog","Surface altitude","m","",2,(/londimout,latdimout/),& &var3didout(42),ierr) call def_var(nout,"height_h","Height (half level)","m","up",3,(/londimout,latdimout,altdimouth/),& &var3didout(43),ierr) call def_var(nout,"pressure_h","Pressure (half level)","Pa","",3,(/londimout,latdimout,altdimouth/),& &var3didout(44),ierr) call def_var(nout,"coor_par_a","Pressure height discretiz. coeff.","Pa","",3,(/londimout,latdimout,altdimouth/),& &var3didout(45),ierr) call def_var(nout,"coor_par_b","Pressure height discretiz. coeff.","","",3,(/londimout,latdimout,altdimouth/),& &var3didout(46),ierr) !on écrit plutot ça dans un .def? ! call def_var(nout,"tend_u","tend_u","-",1,(/altdimout/),var3didout(27),ierr) ! call def_var(nout,"tend_v","tend_v","-",1,(/altdimout/),var3didout(28),ierr) ! call def_var(nout,"tend_w","tend_w","-",1,(/altdimout/),var3didout(29),ierr) ! call def_var(nout,"tend_t","tend_t","-",1,(/altdimout/),var3didout(30),ierr) ! call def_var(nout,"tend_q","tend_q","-",1,(/altdimout/),var3didout(31),ierr) ! call def_var(nout,"nudg_u","nudg_u","-",1,(/altdimout/),var3didout(32),ierr) ! call def_var(nout,"nudg_v","nudg_v","-",1,(/altdimout/),var3didout(33),ierr) ! call def_var(nout,"nudg_w","nudg_w","-",1,(/altdimout/),var3didout(34),ierr) ! call def_var(nout,"nudg_t","nudg_t","-",1,(/altdimout/),var3didout(35),ierr) ! call def_var(nout,"nudg_q","nudg_q","-",1,(/altdimout/),var3didout(36),ierr) ! A FAIRE: ajouter a la suite les scalaires qui sont fournis par profil_init.txt #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(1),zlev) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(1),zlev) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_1" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(2),pres) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(2),pres) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_2" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(3),temp) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(3),temp) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_3" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(4),ovap) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(4),ovap) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_4" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(5),rhum) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(5),rhum) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_5" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(6),theta) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(6),theta) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_6" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(7),rvv) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(7),rvv) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_7" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(8),vitu) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(8),vitu) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_8" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(9),vitv) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(9),vitv) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_9" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(10),vitug) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(10),vitug) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_10" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(11),vitvg) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(11),vitvg) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_11" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(12),vitw) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(12),vitw) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_12" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(13),advu) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(13),advu) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_13" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(14),u_advh) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(14),u_advh) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_14" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(15),u_advv) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(15),u_advv) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_15" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(16),advv) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(16),advv) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_16" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(17),v_advh) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(17),v_advh) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_17" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(18),v_advv) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(18),v_advv) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_18" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(19),advT) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(19),advT) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_19" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(20),T_advh) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(20),T_advh) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_20" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(21),T_advv) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(21),T_advv) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_21" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(22),advq) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(22),advq) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_22" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(23),q_advh) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(23),q_advh) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_23" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(24),q_advv) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(24),q_advv) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_24" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(25),advth) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(25),advth) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_25" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(26),th_advh) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(26),th_advh) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_26" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(27),th_advv) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(27),th_advv) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_27" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(28),advr) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(28),advr) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_28" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(29),r_advh) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(29),r_advh) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_29" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(30),r_advv) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(30),r_advv) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_30" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(31),radT) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(31),radT) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_31" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(32),sens) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(32),sens) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_32" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(33),flat) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(33),flat) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_33" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(34),tsurf) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(34),tsurf) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_34" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(35),ustar) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(35),ustar) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_35" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(36),q1) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(36),q1) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_36" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(37),q2) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(37),q2) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_37" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(38),uw) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(38),uw) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_38" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(39),vw) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(39),vw) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_39" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(40),ps) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(40),ps) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_40" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(41),omega) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(41),omega) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_41" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(42),orog) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(42),orog) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_42" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(43),ppph) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(43),ppph) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_43" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(44),ph) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(44),ph) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_44" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(45),ap) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(45),ap) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_45" endif #ifdef NC_DOUBLE ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(46),bp) #else ierr= NF_PUT_VAR_REAL(nout,var3didout(46),bp) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "putvar3d_46" endif ! toto(:)=tend_u ! ierr= NF_PUT_VAR_INT(nout,var3didout(18),toto) ! toto(:)=tend_v ! ierr= NF_PUT_VAR_INT(nout,var3didout(19),toto) ! toto(:)=tend_w ! ierr= NF_PUT_VAR_INT(nout,var3didout(20),toto) ! toto(:)=tend_t ! ierr= NF_PUT_VAR_INT(nout,var3didout(21),toto) ! toto(:)=tend_q ! ierr= NF_PUT_VAR_INT(nout,var3didout(22),toto) ! toto(:)=nudg_u ! ierr= NF_PUT_VAR_INT(nout,var3didout(23),toto) ! toto(:)=nudg_v ! ierr= NF_PUT_VAR_INT(nout,var3didout(24),toto) ! toto(:)=nudg_w ! ierr= NF_PUT_VAR_INT(nout,var3didout(25),toto) ! toto(:)=nudg_t ! ierr= NF_PUT_VAR_INT(nout,var3didout(26),toto) ! toto(:)=nudg_q ! ierr= NF_PUT_VAR_INT(nout,var3didout(27),toto) ierr=NF_CLOSE(nout) print*, 'fin' contains !********************************************************** Subroutine initiate (filename,x,y,z,zh,time,& londimout,latdimout,altdimout,altdimouth,timedimout,& nj,lm,lmh,ym,xm) implicit none include "netcdf.inc" character (len=*), intent(in):: filename real*8, dimension(:), intent(in):: x,y,z,zh,time !integer, intent(out):: nout,timevarout integer, intent(out):: londimout,latdimout,altdimout,altdimouth,timedimout integer :: altdim,timedim integer :: newvarid integer :: nvarid,ierr,i,kloop,nj,lm,lmh,ym,xm !real, dimension(nj), intent(out) :: time write(*,*) "creating "//trim(adjustl(filename))//'...' ierr = NF_CREATE(filename,NF_CLOBBER, nout) if (ierr.NE.NF_NOERR) THEN WRITE(*,*)'ERROR: Impossible to create the file.' WRITE(*,*) NF_STRERROR(ierr) stop "" endif !ierr = NF_DEF_DIM (nout, "lat", size(lat), latdimout) !ierr = NF_DEF_DIM (nout, "lon", size(lon), londimout) ierr = NF_DEF_DIM (nout, "lat", ym, latdimout) ierr = NF_DEF_DIM (nout, "lon", xm, londimout) ierr = NF_DEF_DIM (nout, "nlev", lm, altdimout) ierr = NF_DEF_DIM (nout, "nlevp1", lmh, altdimouth) ierr = NF_DEF_DIM (nout, "time", nj, timedimout) ierr = NF_ENDDEF(nout) call def_var(nout,"lat","lat","","",1,(/latdimout/),nvarid,ierr) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nout,nvarid,y(1:ym)) #else ierr = NF_PUT_VAR_REAL (nout,nvarid,y(1:ym)) #endif call def_var(nout,"lon","lon","","",1,(/londimout/),nvarid,ierr) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nout,nvarid,x(1:xm)) #else ierr = NF_PUT_VAR_REAL (nout,nvarid,x(1:xm)) #endif !call def_var(nout,"lev","lev","Pa","down",1,(/altdimout/),nvarid,ierr) call def_var(nout,"nlev","nlev","m","up",1,(/altdimout/),nvarid,ierr) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nout,nvarid,z(1:lm)) #else ierr = NF_PUT_VAR_REAL (nout,nvarid,z(1:lm)) #endif !call def_var(nout,"levh","levh","Pa","down",1,(/altdimouth/),nvarid,ierr) call def_var(nout,"nlevp1","nlevp1","m","up",1,(/altdimouth/),nvarid,ierr) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nout,nvarid,zh(1:lmh)) #else ierr = NF_PUT_VAR_REAL (nout,nvarid,zh(1:lmh)) #endif ! Arm_cu call def_var(nout,"time","time","seconds since 1997-06-21 00.00:00","",1,(/timedimout/),nvarid,ierr) ! Rico !call def_var(nout,"time","time","seconds since 2004-12-16 00:00:00","",1,(/timedimout/),nvarid,ierr) ! Bomex !call def_var(nout,"time","time","seconds since 1969-06-24 00:00:00","",1,(/timedimout/),nvarid,ierr) !Cindy !call def_var(nout,"time","time","seconds since 2010-10-01 00:00:00","",1,(/timedimout/),nvarid,ierr) !AMMA ! call def_var(nout,"time","time","seconds since 2006-07-10 00:00:00",1,(/timedimout/),nvarid,ierr) !IHOP ! call def_var(nout,"time","time","seconds since 2002-06-14 00:00:00",1,(/timedimout/),nvarid,ierr) !ierr = NF_PUT_VAR_INT (nout,timevarout,time(1:nj)) #ifdef NC_DOUBLE !ierr = NF_PUT_VAR_DOUBLE (nout,timevarout,time(1:nj)) ierr = NF_PUT_VAR_DOUBLE (nout,nvarid,time(1:nj)) #else !ierr = NF_PUT_VAR_REAL (nout,timevarout,time(1:nj)) ierr = NF_PUT_VAR_REAL (nout,nvarid,time(1:nj)) #endif end subroutine initiate !************************************************************* subroutine def_var(nid,name,title,units,positive,nbdim,dim,nvarid,ierr) implicit none include "netcdf.inc" character (len=*) :: title,units,name,positive integer :: nid,nbdim,nvarid,ierr integer, dimension(nbdim) :: dim ierr=NF_REDEF(nid) #ifdef NC_DOUBLE ierr = NF_DEF_VAR (nid,adjustl(name),NF_DOUBLE,nbdim,dim,nvarid) #else ierr = NF_DEF_VAR (nid,adjustl(name),NF_FLOAT,nbdim,dim,nvarid) #endif if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "in def_var" endif ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", len_trim(adjustl(title)),adjustl(title)) if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "in def_var" endif ierr = NF_PUT_ATT_TEXT (nid, nvarid, "units", len_trim(adjustl(units)),adjustl(units)) if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "in def_var" endif ierr = NF_PUT_ATT_TEXT (nid, nvarid, "positive", len_trim(adjustl(positive)),adjustl(positive)) if(ierr/=NF_NOERR) then write(*,*) NF_STRERROR(ierr) stop "in def_var" endif ierr = NF_ENDDEF(nid) end subroutine def_var !************************************************************* subroutine catchaxis(nid,iim,jjm,llm,nj,xc,yc,zc,time,ierr) !include "/home/distrib/local/netcdf-3.6.1/include/netcdf.inc" include "netcdf.inc" integer, intent(in) :: nid,iim,jjm,llm,nj real*8, dimension(iim), intent(out) :: xc real*8, dimension(jjm), intent(out) :: yc real*8, dimension(llm), intent(out) :: zc real*8, dimension(nj), intent(out) :: time integer, intent(out) :: ierr integer :: i integer :: latvar,lonvar,altvar,timevar integer :: latlen,lonlen,altlen,timelen integer :: londimin,latdimin,altdimin,timedimin ! Control & lecture on dimensions ! =============================== ierr=NF_INQ_DIMID(nid,"yc",latdimin) ierr=NF_INQ_VARID(nid,"yc",latvar) if (ierr.NE.NF_NOERR) then write(*,*) 'ERROR: Field is missing' stop "" endif ierr=NF_INQ_DIMLEN(nid,latdimin,latlen) ierr=NF_INQ_DIMID(nid,"xc",londimin) ierr=NF_INQ_VARID(nid,"xc",lonvar) if (ierr.NE.NF_NOERR) then write(*,*) 'ERROR: Field is lacking' stop "" endif ierr=NF_INQ_DIMLEN(nid,londimin,lonlen) ierr=NF_INQ_DIMID(nid,"zc",altdimin) ierr=NF_INQ_VARID(nid,"zc",altvar) if (ierr.NE.NF_NOERR) then write(*,*) 'ERROR: Field is lacking' stop "" endif ierr=NF_INQ_DIMLEN(nid,altdimin,altlen) !test:on rajoute la dimension temps ierr=NF_INQ_DIMID(nid,"time",timedimin) ierr=NF_INQ_VARID(nid,"time",timevar) if (ierr.NE.NF_NOERR) then write(*,*) 'ERROR: Field