! ! ! PROGRAMA DE LEITURA de arquivos tipo ETAGRDhh.tmh ! PROGRAMA DE LEITURA de arquivos tipo ETAGRDhh.tmh ! ! program leit program leit use variables use variables integer :: dt,kgtype,imdlty,igout,jgout integer :: dt,kgtype,imdlty,igout,jgout real :: dx,lonw,alatvt,lats,dy real :: dx,lonw,alatvt,lats,dy character(len=20) :: field character(len=20) :: field character(len=6) :: nufile,outype,proj,readco,read character(len=6) :: nufile,outype,proj,readco,read character(len=12) :: compl character(len=12) :: compl logical :: ltsoil, lqsoil,north logical :: ltsoil, lqsoil,north logical :: infloop logical :: infloop ! ! ! Dimension 2D variables ! Dimension 2D variables ! ! real,allocatable,dimension(:,:) :: aghf ! real,allocatable,dimension(:,:) :: aghf ! real,allocatable,dimension(:,:) :: alb !SFC real,allocatable,dimension(:,:) :: alb !SFC real,allocatable,dimension(:,:) :: ashf !AVE real,allocatable,dimension(:,:) :: ashf !AVE real,allocatable,dimension(:,:) :: bost ! real,allocatable,dimension(:,:) :: bost ! real,allocatable,dimension(:,:) :: cape !CNVC real,allocatable,dimension(:,:) :: cape !CNVC real,allocatable,dimension(:,:) :: cbh ! real,allocatable,dimension(:,:) :: cbh ! ! GSM real,allocatable,dimension(:,:) :: cbps ! GSM real,allocatable,dimension(:,:) :: cbps ! GSM real,allocatable,dimension(:,:) :: cine ! GSM real,allocatable,dimension(:,:) :: cine ! GSM real,allocatable,dimension(:,:) :: cld ! GSM real,allocatable,dimension(:,:) :: cld real,allocatable,dimension(:,:) :: clsf !AVE real,allocatable,dimension(:,:) :: clsf !AVE real,allocatable,dimension(:,:) :: cssf !AVE real,allocatable,dimension(:,:) :: cssf !AVE real,allocatable,dimension(:,:) :: cth ! real,allocatable,dimension(:,:) :: cth ! ! GSM real,allocatable,dimension(:,:) :: ctps ! GSM real,allocatable,dimension(:,:) :: ctps real,allocatable,dimension(:,:) :: cttp ! real,allocatable,dimension(:,:) :: cttp ! real,allocatable,dimension(:,:) :: cvprec !ACM real,allocatable,dimension(:,:) :: cvprec !ACM real,allocatable,dimension(:,:) :: evpp ! real,allocatable,dimension(:,:) :: evpp ! real,allocatable,dimension(:,:) :: ffcs ! real,allocatable,dimension(:,:) :: ffcs ! real,allocatable,dimension(:,:) :: frvel ! real,allocatable,dimension(:,:) :: frvel ! real,allocatable,dimension(:,:) :: gvco ! real,allocatable,dimension(:,:) :: gvco ! real,allocatable,dimension(:,:) :: hatt ! real,allocatable,dimension(:,:) :: hatt ! real,allocatable,dimension(:,:) :: higcf !HIGH real,allocatable,dimension(:,:) :: higcf !HIGH ! GSM real,allocatable,dimension(:,:) :: htfrz ! GSM real,allocatable,dimension(:,:) :: htfrz real,allocatable,dimension(:,:) :: icld ! real,allocatable,dimension(:,:) :: icld ! real,allocatable,dimension(:,:) :: ighf ! real,allocatable,dimension(:,:) :: ighf ! real,allocatable,dimension(:,:) :: ilwr ! real,allocatable,dimension(:,:) :: ilwr ! real,allocatable,dimension(:,:) :: ipty ! real,allocatable,dimension(:,:) :: ipty ! real,allocatable,dimension(:,:) :: iswr ! real,allocatable,dimension(:,:) :: iswr ! ! GSM real,allocatable,dimension(:,:) :: li ! GSM real,allocatable,dimension(:,:) :: li real,allocatable,dimension(:,:) :: lowcf !LOW real,allocatable,dimension(:,:) :: lowcf !LOW ! GSM real,allocatable,dimension(:,:) :: lsmk ! GSM real,allocatable,dimension(:,:) :: lsmk real,allocatable,dimension(:,:) :: lsprec !ACM real,allocatable,dimension(:,:) :: lsprec !ACM real,allocatable,dimension(:,:) :: midcf !MID real,allocatable,dimension(:,:) :: midcf !MID real,allocatable,dimension(:,:) :: mwhl ! real,allocatable,dimension(:,:) :: mwhl ! ! GSM real,allocatable,dimension(:,:) :: mwpl ! GSM real,allocatable,dimension(:,:) :: mwpl real,allocatable,dimension(:,:) :: oces !AVE real,allocatable,dimension(:,:) :: oces !AVE real,allocatable,dimension(:,:) :: ocis !AVE real,allocatable,dimension(:,:) :: ocis !AVE real,allocatable,dimension(:,:) :: oles !AVE real,allocatable,dimension(:,:) :: oles !AVE real,allocatable,dimension(:,:) :: olis !AVE real,allocatable,dimension(:,:) :: olis !AVE real,allocatable,dimension(:,:) :: pnmm !MESI real,allocatable,dimension(:,:) :: pnmm !MESI real,allocatable,dimension(:,:) :: pnms ! real,allocatable,dimension(:,:) :: pnms ! real,allocatable,dimension(:,:) :: potevap !ACC real,allocatable,dimension(:,:) :: potevap !ACC real,allocatable,dimension(:,:) :: ps !SURF real,allocatable,dimension(:,:) :: ps !SURF ! GSM real,allocatable,dimension(:,:) :: ptrop ! GSM real,allocatable,dimension(:,:) :: ptrop real,allocatable,dimension(:,:) :: pw !PREC real,allocatable,dimension(:,:) :: pw !PREC ! GSM real,allocatable,dimension(:,:) :: qs ! GSM real,allocatable,dimension(:,:) :: qs real,allocatable,dimension(:,:) :: qsoil01 !SOIL real,allocatable,dimension(:,:) :: qsoil01 !SOIL real,allocatable,dimension(:,:) :: qsoil20 !SOIL real,allocatable,dimension(:,:) :: qsoil20 !SOIL real,allocatable,dimension(:,:) :: rctt ! real,allocatable,dimension(:,:) :: rctt ! ! GSM real,allocatable,dimension(:,:) :: rhfrz ! GSM real,allocatable,dimension(:,:) :: rhfrz real,allocatable,dimension(:,:) :: rnof !ACM real,allocatable,dimension(:,:) :: rnof !ACM > real,allocatable,dimension(:,:) :: rnofsg !ACM real,allocatable,dimension(:,:) :: roce !AVE real,allocatable,dimension(:,:) :: roce !AVE real,allocatable,dimension(:,:) :: role !AVE real,allocatable,dimension(:,:) :: role !AVE real,allocatable,dimension(:,:) :: sexc ! real,allocatable,dimension(:,:) :: sexc ! real,allocatable,dimension(:,:) :: smal ! real,allocatable,dimension(:,:) :: smal ! real,allocatable,dimension(:,:) :: smav !SOIL real,allocatable,dimension(:,:) :: smav !SOIL real,allocatable,dimension(:,:) :: smof ! real,allocatable,dimension(:,:) :: smof ! real,allocatable,dimension(:,:) :: snofal !ACM real,allocatable,dimension(:,:) :: snofal !ACM real,allocatable,dimension(:,:) :: srhel ! real,allocatable,dimension(:,:) :: srhel ! real,allocatable,dimension(:,:) :: strop ! real,allocatable,dimension(:,:) :: strop ! real,allocatable,dimension(:,:) :: tdsh !SHEL real,allocatable,dimension(:,:) :: tdsh !SHEL real,allocatable,dimension(:,:) :: ts !SFC real,allocatable,dimension(:,:) :: ts !SFC real,allocatable,dimension(:,:) :: tsh !SHEL real,allocatable,dimension(:,:) :: tsh !SHEL > real,allocatable,dimension(:,:) :: tmax !MAX > real,allocatable,dimension(:,:) :: tmin !MIN real,allocatable,dimension(:,:) :: tsoil01 !SOIL real,allocatable,dimension(:,:) :: tsoil01 !SOIL real,allocatable,dimension(:,:) :: tsoil20 !SOIL real,allocatable,dimension(:,:) :: tsoil20 !SOIL real,allocatable,dimension(:,:) :: tsom ! real,allocatable,dimension(:,:) :: tsom ! real,allocatable,dimension(:,:) :: ttprec !ACM real,allocatable,dimension(:,:) :: ttprec !ACM real,allocatable,dimension(:,:) :: ttrop ! real,allocatable,dimension(:,:) :: ttrop ! real,allocatable,dimension(:,:) :: uanem !U WI real,allocatable,dimension(:,:) :: uanem !U WI > real,allocatable,dimension(:,:) :: u100m !U WI > real,allocatable,dimension(:,:) :: v100m !V WI ! GSM real,allocatable,dimension(:,:) :: ucmw ! GSM real,allocatable,dimension(:,:) :: ucmw real,allocatable,dimension(:,:) :: usst !SFC | ! GSM real,allocatable,dimension(:,:) :: usst real,allocatable,dimension(:,:) :: ustrm !U CO | ! GSM real,allocatable,dimension(:,:) :: ustrm real,allocatable,dimension(:,:) :: utrop ! real,allocatable,dimension(:,:) :: utrop ! real,allocatable,dimension(:,:) :: vanem !V WI real,allocatable,dimension(:,:) :: vanem !V WI ! GSM real,allocatable,dimension(:,:) :: vcmw ! GSM real,allocatable,dimension(:,:) :: vcmw real,allocatable,dimension(:,:) :: vegtyp !VEGE real,allocatable,dimension(:,:) :: vegtyp !VEGE real,allocatable,dimension(:,:) :: vsst !SFC | ! GSM real,allocatable,dimension(:,:) :: vsst real,allocatable,dimension(:,:) :: vstrm !V CO | ! GSM real,allocatable,dimension(:,:) :: vstrm real,allocatable,dimension(:,:) :: vtrop ! real,allocatable,dimension(:,:) :: vtrop ! ! GSM real,allocatable,dimension(:,:) :: zorl ! GSM real,allocatable,dimension(:,:) :: zorl ! GSM real,allocatable,dimension(:,:) :: zs ! GSM real,allocatable,dimension(:,:) :: zs real,allocatable,dimension(:,:) :: GRIB real,allocatable,dimension(:,:) :: GRIB ! ! ! ! ! Dimension 3D variables ! Dimension 3D variables ! ! real,allocatable,dimension(:,:,:) :: cips ! real,allocatable,dimension(:,:,:) :: cips ! ! GSM real,allocatable,dimension(:,:,:) :: clwt !CLO ! GSM real,allocatable,dimension(:,:,:) :: clwt !CLO real,allocatable,dimension(:,:,:) :: ome !OMEGA ON PR real,allocatable,dimension(:,:,:) :: ome !OMEGA ON PR real,allocatable,dimension(:,:,:) :: phi !HEIGHT OF P real,allocatable,dimension(:,:,:) :: phi !HEIGHT OF P real,allocatable,dimension(:,:,:) :: q !SPEC HUM O real,allocatable,dimension(:,:,:) :: q !SPEC HUM O real,allocatable,dimension(:,:,:) :: rh !REL HUMID O real,allocatable,dimension(:,:,:) :: rh !REL HUMID O real,allocatable,dimension(:,:,:) :: temp !TEMP ON PRE real,allocatable,dimension(:,:,:) :: temp !TEMP ON PRE ! GSM real,allocatable,dimension(:,:,:) :: thte !THE ! GSM real,allocatable,dimension(:,:,:) :: thte !THE real,allocatable,dimension(:,:,:) :: u !U WIND ON P real,allocatable,dimension(:,:,:) :: u !U WIND ON P real,allocatable,dimension(:,:,:) :: v !V WIND ON P real,allocatable,dimension(:,:,:) :: v !V WIND ON P infloop=.true. infloop=.true. ! READ OUTPUT GRID SPECIFICATIONS. ! READ OUTPUT GRID SPECIFICATIONS. ! ! rewind(18) rewind(18) read(18,1000) kgtype read(18,1000) kgtype read(18,1000) imdlty read(18,1000) imdlty read(18,1030) dataset read(18,1030) dataset read(18,1030) outype read(18,1030) outype read(18,1030) nufile read(18,1030) nufile read(18,1030) proj read(18,1030) proj read(18,1010) north read(18,1010) north read(18,1000) im read(18,1000) im read(18,1000) jm read(18,1000) jm read(18,1020) dx read(18,1020) dx read(18,1020) lonw read(18,1020) lonw read(18,1020) alatvt read(18,1020) alatvt read(18,1020) lats read(18,1020) lats read(18,1020) dy read(18,1020) dy read(18,1030) readll read(18,1030) readll read(18,1030) readco read(18,1030) readco 1000 format(T28,I5) 1000 format(T28,I5) 1010 format(T28,L1) 1010 format(T28,L1) 1020 format(T28,F11.6) 1020 format(T28,F11.6) 1030 format(T28,A6) 1030 format(T28,A6) print*,"im: ",im," jm: ",jm print*,"im: ",im," jm: ",jm ! Allocate variables ! Allocate variables allocate(GRIB(im,jm)) allocate(GRIB(im,jm)) allocate(pnmm(im,jm)) allocate(pnmm(im,jm)) allocate(ps(im,jm)) allocate(ps(im,jm)) ! GSM allocate(zs(im,jm)) ! GSM allocate(zs(im,jm)) allocate(ts(im,jm)) allocate(ts(im,jm)) ! GSM allocate(qs(im,jm)) ! GSM allocate(qs(im,jm)) allocate(tsh(im,jm)) allocate(tsh(im,jm)) > allocate(tmax(im,jm)) > allocate(tmin(im,jm)) allocate(tdsh(im,jm)) allocate(tdsh(im,jm)) allocate(uanem(im,jm)) allocate(uanem(im,jm)) allocate(vanem(im,jm)) allocate(vanem(im,jm)) > allocate(u100m(im,jm)) > allocate(v100m(im,jm)) allocate(ttprec(im,jm)) allocate(ttprec(im,jm)) allocate(cvprec(im,jm)) allocate(cvprec(im,jm)) allocate(lsprec(im,jm)) allocate(lsprec(im,jm)) allocate(snofal(im,jm)) allocate(snofal(im,jm)) allocate(clsf(im,jm)) allocate(clsf(im,jm)) allocate(cssf(im,jm)) allocate(cssf(im,jm)) allocate(cape(im,jm)) allocate(cape(im,jm)) ! GSM allocate(cine(im,jm)) ! GSM allocate(cine(im,jm)) allocate(pw(im,jm)) allocate(pw(im,jm)) ! GSM allocate(cld(im,jm)) ! GSM allocate(cld(im,jm)) allocate(role(im,jm)) allocate(role(im,jm)) allocate(ustrm(im,jm)) | ! GSM allocate(ustrm(im,jm)) allocate(vstrm(im,jm)) | ! GSM allocate(vstrm(im,jm)) ! GSM allocate(ptrop(im,jm)) ! GSM allocate(ptrop(im,jm)) ! GSM allocate(htfrz(im,jm)) ! GSM allocate(htfrz(im,jm)) ! GSM allocate(rhfrz(im,jm)) ! GSM allocate(rhfrz(im,jm)) ! GSM allocate(li(im,jm)) ! GSM allocate(li(im,jm)) ! GSM allocate(zorl(im,jm)) ! GSM allocate(zorl(im,jm)) allocate(usst(im,jm)) | ! GSM allocate(usst(im,jm)) allocate(vsst(im,jm)) | ! GSM allocate(vsst(im,jm)) allocate(ocis(im,jm)) allocate(ocis(im,jm)) allocate(olis(im,jm)) allocate(olis(im,jm)) allocate(oces(im,jm)) allocate(oces(im,jm)) allocate(oles(im,jm)) allocate(oles(im,jm)) allocate(roce(im,jm)) allocate(roce(im,jm)) allocate(potevap(im,jm)) allocate(potevap(im,jm)) allocate(tsoil01(im,jm)) allocate(tsoil01(im,jm)) allocate(tsoil20(im,jm)) allocate(tsoil20(im,jm)) allocate(qsoil01(im,jm)) allocate(qsoil01(im,jm)) allocate(qsoil20(im,jm)) allocate(qsoil20(im,jm)) allocate(rnof(im,jm)) allocate(rnof(im,jm)) > allocate(rnofsg(im,jm)) allocate(alb(im,jm)) allocate(alb(im,jm)) ! GSM allocate(lsmk(im,jm)) ! GSM allocate(lsmk(im,jm)) ! Variaveis novas introduzidas pelo ETA 2d ! Variaveis novas introduzidas pelo ETA 2d ! ! allocate(smav(im,jm)) allocate(smav(im,jm)) allocate(aghf(im,jm)) allocate(aghf(im,jm)) ! GSM allocate(mwpl(im,jm)) ! GSM allocate(mwpl(im,jm)) ! GSM allocate(ucmw(im,jm)) ! GSM allocate(ucmw(im,jm)) ! GSM allocate(vcmw(im,jm)) ! GSM allocate(vcmw(im,jm)) allocate(lowcf(im,jm)) allocate(lowcf(im,jm)) allocate(midcf(im,jm)) allocate(midcf(im,jm)) allocate(higcf(im,jm)) allocate(higcf(im,jm)) ! GSM allocate(cbps(im,jm)) ! GSM allocate(cbps(im,jm)) ! GSM allocate(ctps(im,jm)) ! GSM allocate(ctps(im,jm)) ! Variaveis 3D ! Variaveis 3D allocate(ome(im,jm,kmax)) allocate(ome(im,jm,kmax)) allocate(phi(im,jm,kmax)) allocate(phi(im,jm,kmax)) allocate(temp(im,jm,kmax)) allocate(temp(im,jm,kmax)) allocate(q(im,jm,kmax)) allocate(q(im,jm,kmax)) allocate(rh(im,jm,kmax)) allocate(rh(im,jm,kmax)) allocate(u(im,jm,kmax)) allocate(u(im,jm,kmax)) allocate(v(im,jm,kmax)) allocate(v(im,jm,kmax)) ! GSM allocate(clwt(im,jm,kmax)) ! GSM allocate(clwt(im,jm,kmax)) ! GSM allocate(thte(im,jm,kmax)) ! GSM allocate(thte(im,jm,kmax)) OPEN(unit=51,status='old',form='unformatted') OPEN(unit=51,status='old',form='unformatted') ! get I and J indexes for the smaller domain ! get I and J indexes for the smaller domain ! IW= ABS((-83) - (-83))/ 0.40 + 1 ! IW= ABS((-83) - (-83))/ 0.40 + 1 ! IE= ABS((-83) - (-25.8))/ 0.40 + 1 ! IE= ABS((-83) - (-25.8))/ 0.40 + 1 ! JS= ABS((-50.2) - (-50.2))/ 0.40 + 1 ! JS= ABS((-50.2) - (-50.2))/ 0.40 + 1 ! JN= ABS((-50.2) - (12.2))/ 0.40 + 1 ! JN= ABS((-50.2) - (12.2))/ 0.40 + 1 IW= 1 IW= 1 IE= im IE= im JS= 1 JS= 1 JN= jm JN= jm ! ! ! get the nx and ny number of points in x and y direction ! get the nx and ny number of points in x and y direction nx = ie - iw + 1 nx = ie - iw + 1 ny = jn - js + 1 ny = jn - js + 1 ! ! ! get the exactly lat/lon of the smaller domain ! get the exactly lat/lon of the smaller domain ! ! clonll= -lonw + ((iw-1) * dx) clonll= -lonw + ((iw-1) * dx) clonur= -lonw + ((ie-1) * dx) clonur= -lonw + ((ie-1) * dx) clatll= lats + ((js-1) * dy) clatll= lats + ((js-1) * dy) clatur= lats + ((jn-1) * dy) clatur= lats + ((jn-1) * dy) print*, iw, ie, js, jn print*, iw, ie, js, jn print*, clonll, clonur, clatll, clatur print*, clonll, clonur, clatll, clatur READ(51) IHRST,IMM,IDD,IYY,IHH READ(51) IHRST,IMM,IDD,IYY,IHH print*, ' reading header' print*, ' reading header' READ(51) KGTYP,PROJ,NORTH,IMOUT,JMOUT,POLEI,POLEJ,ALA READ(51) KGTYP,PROJ,NORTH,IMOUT,JMOUT,POLEI,POLEJ,ALA kqs=0 kqs=0 kts=0 kts=0 kt=0 kt=0 kq=0 kq=0 kr=0 kr=0 kp=0 kp=0 kw=0 kw=0 ku=0 ku=0 kv=0 kv=0 kc=0 kc=0 ltsoil=.false. ltsoil=.false. lqsoil=.false. lqsoil=.false. do while (infloop) do while (infloop) READ(51,END=999) FIELD,SFC READ(51,END=999) FIELD,SFC print*, field, sfc print*, field, sfc READ(51) GRIB READ(51) GRIB if (field.eq. 'MESINGER MEAN SLP ') then; pnmm=g if (field.eq. 'MESINGER MEAN SLP ') then; pnmm=g elseif (field.eq.'SURFACE PRESSURE ') then; ps=gri elseif (field.eq.'SURFACE PRESSURE ') then; ps=gri ! GSM elseif (field.eq.'SURFACE HEIGHT ') then; z ! GSM elseif (field.eq.'SURFACE HEIGHT ') then; z elseif (field.eq.'SFC (SKIN) TEMPRATUR') then; ts=gri elseif (field.eq.'SFC (SKIN) TEMPRATUR') then; ts=gri ! GSM elseif (field.eq.'SURFACE SPEC HUMID ') then; q ! GSM elseif (field.eq.'SURFACE SPEC HUMID ') then; q elseif (field.eq.'SHELTER TEMPERATURE ') then; tsh=gr elseif (field.eq.'SHELTER TEMPERATURE ') then; tsh=gr > elseif (field.eq.'MAX TEMPERATURE ') then; tmax=g > elseif (field.eq.'MIN TEMPERATURE ') then; tmin=g elseif (field.eq.'SHELTER DEWPOINT ') then; tdsh=g elseif (field.eq.'SHELTER DEWPOINT ') then; tdsh=g elseif (field.eq.'U WIND AT ANEMOM HT ') then; uanem= elseif (field.eq.'U WIND AT ANEMOM HT ') then; uanem= elseif (field.eq.'V WIND AT ANEMOM HT ') then; vanem= elseif (field.eq.'V WIND AT ANEMOM HT ') then; vanem= > elseif (field.eq.'U WIND 100M ') then; u100m= > elseif (field.eq.'V WIND 100M ') then; v100m= elseif (field.eq.'ACM TOTAL PRECIP ') then; ttprec elseif (field.eq.'ACM TOTAL PRECIP ') then; ttprec elseif (field.eq.'ACM CONVCTIVE PRECIP') then; cvprec elseif (field.eq.'ACM CONVCTIVE PRECIP') then; cvprec elseif (field.eq.'ACM GRD SCALE PRECIP') then; lsprec elseif (field.eq.'ACM GRD SCALE PRECIP') then; lsprec elseif (field.eq.'ACM SNOWFALL ') then; snofal elseif (field.eq.'ACM SNOWFALL ') then; snofal elseif (field.eq.'AVE SFC LATHEAT FX ') then; clsf=g elseif (field.eq.'AVE SFC LATHEAT FX ') then; clsf=g elseif (field.eq.'AVE SFC SENHEAT FX ') then; cssf=g elseif (field.eq.'AVE SFC SENHEAT FX ') then; cssf=g elseif (field.eq.'CNVCT AVBL POT ENRGY') then; cape=g elseif (field.eq.'CNVCT AVBL POT ENRGY') then; cape=g ! GSM elseif (field.eq.'CNVCT INHIBITION ') then; c ! GSM elseif (field.eq.'CNVCT INHIBITION ') then; c elseif (field.eq.'PRECIPITABLE WATER ') then; pw=gri elseif (field.eq.'PRECIPITABLE WATER ') then; pw=gri ! GSM elseif (field.eq.'AVG TOTAL CLD FRAC ') then; c ! GSM elseif (field.eq.'AVG TOTAL CLD FRAC ') then; c elseif (field.eq.'AVE OUTGO TOA LW RAD') then; role=g elseif (field.eq.'AVE OUTGO TOA LW RAD') then; role=g elseif (field.eq.'U COMP STORM MOTION ') then; ustrm= | ! GSM elseif (field.eq.'U COMP STORM MOTION ') then; u elseif (field.eq.'V COMP STORM MOTION ') then; vstrm= | ! GSM elseif (field.eq.'V COMP STORM MOTION ') then; v ! GSM elseif (field.eq.'PRESS AT TROPOPAUSE ') then; p ! GSM elseif (field.eq.'PRESS AT TROPOPAUSE ') then; p ! GSM elseif (field.eq.'HEIGHT OF FRZ LVL ') then; h ! GSM elseif (field.eq.'HEIGHT OF FRZ LVL ') then; h ! GSM elseif (field.eq.'REL HUMID AT FRZ LVL') then; r ! GSM elseif (field.eq.'REL HUMID AT FRZ LVL') then; r ! GSM elseif (field.eq.'LIFTED INDEX--BEST ') then; l ! GSM elseif (field.eq.'LIFTED INDEX--BEST ') then; l ! GSM elseif (field.eq.'ROUGHNESS LENGTH ') then; z ! GSM elseif (field.eq.'ROUGHNESS LENGTH ') then; z elseif (field.eq.'SFC U WIND STRESS ') then; usst=g | ! GSM elseif (field.eq.'SFC U WIND STRESS ') then; u elseif (field.eq.'SFC V WIND STRESS ') then; vsst=g | ! GSM elseif (field.eq.'SFC V WIND STRESS ') then; v elseif (field.eq.'AVE INCMG SFC SW RAD') then; ocis=g elseif (field.eq.'AVE INCMG SFC SW RAD') then; ocis=g elseif (field.eq.'AVE INCMG SFC LW RAD') then; olis=g elseif (field.eq.'AVE INCMG SFC LW RAD') then; olis=g elseif (field.eq.'AVE OUTGO SFC SW RAD') then; oces=- elseif (field.eq.'AVE OUTGO SFC SW RAD') then; oces=- elseif (field.eq.'AVE OUTGO SFC LW RAD') then; oles=- elseif (field.eq.'AVE OUTGO SFC LW RAD') then; oles=- elseif (field.eq.'AVE OUTGO TOA SW RAD') then; roce=g elseif (field.eq.'AVE OUTGO TOA SW RAD') then; roce=g elseif (field.eq.'ACC POT EVAPORATION ') then; poteva elseif (field.eq.'ACC POT EVAPORATION ') then; poteva elseif (field.eq.'SOIL TEMPERATURE ') then elseif (field.eq.'SOIL TEMPERATURE ') then if (.not.ltsoil) then ! it is the first soil layer if (.not.ltsoil) then ! it is the first soil layer ltsoil=.true. ltsoil=.true. tsoil01=grib tsoil01=grib else else tsoil20=grib tsoil20=grib endif endif elseif (field.eq.'SOIL MOISTURE ') then elseif (field.eq.'SOIL MOISTURE ') then if (.not.lqsoil) then ! it is the first soil layer if (.not.lqsoil) then ! it is the first soil layer lqsoil=.true. lqsoil=.true. qsoil01=grib qsoil01=grib else else qsoil20=grib qsoil20=grib endif endif elseif (field.eq.'ACM STORM SFC RNOFF ') then; rnof=g elseif (field.eq.'ACM STORM SFC RNOFF ') then; rnof=g > elseif (field.eq.'ACM BSFL-GDWR RNOFF ') then; rnofsg elseif (field.eq.'SFC MIDDAY ALBEDO ') then; alb=gr elseif (field.eq.'SFC MIDDAY ALBEDO ') then; alb=gr ! GSM elseif (field.eq.'LAND/SEA MASK ') then; l ! GSM elseif (field.eq.'LAND/SEA MASK ') then; l ! ! ! retrieving 3d fields ! retrieving 3d fields ! ! elseif (field.eq.'OMEGA ON PRESS SFCS ') then; kw=kw+ elseif (field.eq.'OMEGA ON PRESS SFCS ') then; kw=kw+ elseif (field.eq.'HEIGHT OF PRESS SFCS') then; kp=kp+ elseif (field.eq.'HEIGHT OF PRESS SFCS') then; kp=kp+ elseif (field.eq.'TEMP ON PRESS SFCS ') then; kt=kt+ elseif (field.eq.'TEMP ON PRESS SFCS ') then; kt=kt+ elseif (field.eq.'SPEC HUM ON P SFCS ') then; kq=kq+ elseif (field.eq.'SPEC HUM ON P SFCS ') then; kq=kq+ elseif (field.eq.'REL HUMID ON P SFCS ') then; kr=kr+ elseif (field.eq.'REL HUMID ON P SFCS ') then; kr=kr+ elseif (field.eq.'U WIND ON PRESS SFCS') then; ku=ku+ elseif (field.eq.'U WIND ON PRESS SFCS') then; ku=ku+ elseif (field.eq.'V WIND ON PRESS SFCS') then; kv=kv+ elseif (field.eq.'V WIND ON PRESS SFCS') then; kv=kv+ ! GSM elseif (field.eq.'CLOUD WATR ON P SFCS') then; k ! GSM elseif (field.eq.'CLOUD WATR ON P SFCS') then; k ! ! ! Variaveis novas introduzidas pelo ETA 2d ! Variaveis novas introduzidas pelo ETA 2d ! ! elseif (field.eq.'SOIL MOISTURE AVAIL ') then; smav=g elseif (field.eq.'SOIL MOISTURE AVAIL ') then; smav=g elseif (field.eq.'AVE GROUND HEAT FX ') then; aghf=g elseif (field.eq.'AVE GROUND HEAT FX ') then; aghf=g ! GSM elseif (field.eq.'MAX WIND PRESS LEVEL') then; m ! GSM elseif (field.eq.'MAX WIND PRESS LEVEL') then; m ! GSM elseif (field.eq.'U COMP MAX WIND ') then; u ! GSM elseif (field.eq.'U COMP MAX WIND ') then; u ! GSM elseif (field.eq.'V COMP MAX WIND ') then; v ! GSM elseif (field.eq.'V COMP MAX WIND ') then; v elseif (field.eq.'LOW CLOUD FRACTION ') then; lowcf= elseif (field.eq.'LOW CLOUD FRACTION ') then; lowcf= elseif (field.eq.'MID CLOUD FRACTION ') then; midcf= elseif (field.eq.'MID CLOUD FRACTION ') then; midcf= elseif (field.eq.'HIGH CLOUD FRACTION ') then; higcf= elseif (field.eq.'HIGH CLOUD FRACTION ') then; higcf= ! GSM elseif (field.eq.'CLOUD BOT PRESSURE ') then; c ! GSM elseif (field.eq.'CLOUD BOT PRESSURE ') then; c ! GSM elseif (field.eq.'CLOUD TOP PRESSURE ') then; c ! GSM elseif (field.eq.'CLOUD TOP PRESSURE ') then; c endif endif enddo enddo 999 continue 999 continue ! ! ! Calculate Theta_e ! Calculate Theta_e ! ! ! GSM call thetae(im,jm,kmax,pr,temp,q,thte) ! GSM call thetae(im,jm,kmax,pr,temp,q,thte) ! ! ! ! ! save fields for Grads plotting. First 2D, then 3D fields ! save fields for Grads plotting. First 2D, then 3D fields ! ! OPEN(unit=17, STATUS='UNKNOWN', & OPEN(unit=17, STATUS='UNKNOWN', & & form='unformatted',access='direct' , & form='unformatted',access='direct' , & recl=4*nx*ny) & recl=4*nx*ny) irec=1 irec=1 write(17,rec=irec)((pnmm(i,j),i=iw,ie),j=js,jn) write(17,rec=irec)((pnmm(i,j),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 write(17,rec=irec)((ps(i,j),i=iw,ie),j=js,jn) write(17,rec=irec)((ps(i,j),i=iw,ie),j=js,jn) ! GSM irec=irec+1 ! GSM irec=irec+1 ! GSM write(17,rec=irec)((zs(i,j),i=iw,ie),j=js,jn) ! GSM write(17,rec=irec)((zs(i,j),i=iw,ie),j=js,jn) ! GSM irec=irec+1 ! GSM irec=irec+1 ! GSM write(17,rec=irec)((lsmk(i,j),i=iw,ie),j=js,jn) ! GSM write(17,rec=irec)((lsmk(i,j),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 write(17,rec=irec)((tsh(i,j),i=iw,ie),j=js,jn) write(17,rec=irec)((tsh(i,j),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 > write(17,rec=irec)((tmax(i,j),i=iw,ie),j=js,jn) > irec=irec+1 > write(17,rec=irec)((tmin(i,j),i=iw,ie),j=js,jn) > irec=irec+1 write(17,rec=irec)((tdsh(i,j),i=iw,ie),j=js,jn) write(17,rec=irec)((tdsh(i,j),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 write(17,rec=irec)((uanem(i,j),i=iw,ie),j=js,jn) write(17,rec=irec)((uanem(i,j),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 write(17,rec=irec)((vanem(i,j),i=iw,ie),j=js,jn) | write(17,rec=irec)((vanem(i,j),i=iw,ie),j=js,jn) > irec=irec+1 > write(17,rec=irec)((u100m(i,j),i=iw,ie),j=js,jn) > irec=irec+1 > write(17,rec=irec)((v100m(i,j),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 where(ttprec<=0.) ttprec=0. where(ttprec<=0.) ttprec=0. write(17,rec=irec)((ttprec(i,j),i=iw,ie),j=js,jn) write(17,rec=irec)((ttprec(i,j),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 where(cvprec<=0.) cvprec=0. where(cvprec<=0.) cvprec=0. write(17,rec=irec)((cvprec(i,j),i=iw,ie),j=js,jn) write(17,rec=irec)((cvprec(i,j),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 where(lsprec<=0.) lsprec=0. where(lsprec<=0.) lsprec=0. write(17,rec=irec)((lsprec(i,j),i=iw,ie),j=js,jn) write(17,rec=irec)((lsprec(i,j),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 write(17,rec=irec)((snofal(i,j),i=iw,ie),j=js,jn) write(17,rec=irec)((snofal(i,j),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 write(17,rec=irec)((clsf(i,j),i=iw,ie),j=js,jn) write(17,rec=irec)((clsf(i,j),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 write(17,rec=irec)((cssf(i,j),i=iw,ie),j=js,jn) write(17,rec=irec)((cssf(i,j),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 write(17,rec=irec)((aghf(i,j),i=iw,ie),j=js,jn) write(17,rec=irec)((aghf(i,j),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 write(17,rec=irec)((ts(i,j),i=iw,ie),j=js,jn) write(17,rec=irec)((ts(i,j),i=iw,ie),j=js,jn) ! GSM irec=irec+1 ! GSM irec=irec+1 ! GSM write(17,rec=irec)((qs(i,j),i=iw,ie),j=js,jn) ! GSM write(17,rec=irec)((qs(i,j),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 write(17,rec=irec)((tsoil01(i,j),i=iw,ie),j=js,jn) write(17,rec=irec)((tsoil01(i,j),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 write(17,rec=irec)((tsoil20(i,j),i=iw,ie),j=js,jn) write(17,rec=irec)((tsoil20(i,j),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 write(17,rec=irec)((qsoil01(i,j),i=iw,ie),j=js,jn) write(17,rec=irec)((qsoil01(i,j),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 write(17,rec=irec)((qsoil20(i,j),i=iw,ie),j=js,jn) write(17,rec=irec)((qsoil20(i,j),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 write(17,rec=irec)((smav(i,j),i=iw,ie),j=js,jn) write(17,rec=irec)((smav(i,j),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 write(17,rec=irec)((rnof(i,j),i=iw,ie),j=js,jn) | write(17,rec=irec)((rnof(i,j),i=iw,ie),j=js,jn) > irec=irec+1 > write(17,rec=irec)((rnofsg(i,j),i=iw,ie),j=js,jn) ! GSM irec=irec+1 ! GSM irec=irec+1 ! GSM write(17,rec=irec)((zorl(i,j),i=iw,ie),j=js,jn) ! GSM write(17,rec=irec)((zorl(i,j),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 write(17,rec=irec)((potevap(i,j),i=iw,ie),j=js,jn) write(17,rec=irec)((potevap(i,j),i=iw,ie),j=js,jn) irec=irec+1 | ! GSM irec=irec+1 write(17,rec=irec)((usst(i,j),i=iw,ie),j=js,jn) | ! GSM write(17,rec=irec)((usst(i,j),i=iw,ie),j=js,jn) irec=irec+1 | ! GSM irec=irec+1 write(17,rec=irec)((vsst(i,j),i=iw,ie),j=js,jn) | ! GSM write(17,rec=irec)((vsst(i,j),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 write(17,rec=irec)((lowcf(i,j),i=iw,ie),j=js,jn) write(17,rec=irec)((lowcf(i,j),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 write(17,rec=irec)((midcf(i,j),i=iw,ie),j=js,jn) write(17,rec=irec)((midcf(i,j),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 write(17,rec=irec)((higcf(i,j),i=iw,ie),j=js,jn) write(17,rec=irec)((higcf(i,j),i=iw,ie),j=js,jn) ! GSM irec=irec+1 ! GSM irec=irec+1 ! GSM write(17,rec=irec)((cld(i,j),i=iw,ie),j=js,jn) ! GSM write(17,rec=irec)((cld(i,j),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 write(17,rec=irec)((ocis(i,j),i=iw,ie),j=js,jn) write(17,rec=irec)((ocis(i,j),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 write(17,rec=irec)((olis(i,j),i=iw,ie),j=js,jn) write(17,rec=irec)((olis(i,j),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 write(17,rec=irec)((oces(i,j),i=iw,ie),j=js,jn) write(17,rec=irec)((oces(i,j),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 write(17,rec=irec)((oles(i,j),i=iw,ie),j=js,jn) write(17,rec=irec)((oles(i,j),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 write(17,rec=irec)((roce(i,j),i=iw,ie),j=js,jn) write(17,rec=irec)((roce(i,j),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 write(17,rec=irec)((role(i,j),i=iw,ie),j=js,jn) write(17,rec=irec)((role(i,j),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 write(17,rec=irec)((alb(i,j),i=iw,ie),j=js,jn) write(17,rec=irec)((alb(i,j),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 write(17,rec=irec)((cape(i,j),i=iw,ie),j=js,jn) write(17,rec=irec)((cape(i,j),i=iw,ie),j=js,jn) ! GSM irec=irec+1 ! GSM irec=irec+1 ! GSM write(17,rec=irec)((cine(i,j),i=iw,ie),j=js,jn) ! GSM write(17,rec=irec)((cine(i,j),i=iw,ie),j=js,jn) ! GSM irec=irec+1 ! GSM irec=irec+1 ! GSM write(17,rec=irec)((li(i,j),i=iw,ie),j=js,jn) ! GSM write(17,rec=irec)((li(i,j),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 write(17,rec=irec)((pw(i,j),i=iw,ie),j=js,jn) write(17,rec=irec)((pw(i,j),i=iw,ie),j=js,jn) ! GSM irec=irec+1 ! GSM irec=irec+1 ! GSM write(17,rec=irec)((ptrop(i,j),i=iw,ie),j=js,jn) ! GSM write(17,rec=irec)((ptrop(i,j),i=iw,ie),j=js,jn) ! GSM irec=irec+1 ! GSM irec=irec+1 ! GSM write(17,rec=irec)((htfrz(i,j),i=iw,ie),j=js,jn) ! GSM write(17,rec=irec)((htfrz(i,j),i=iw,ie),j=js,jn) ! GSM irec=irec+1 ! GSM irec=irec+1 ! GSM write(17,rec=irec)((rhfrz(i,j),i=iw,ie),j=js,jn) ! GSM write(17,rec=irec)((rhfrz(i,j),i=iw,ie),j=js,jn) ! GSM irec=irec+1 ! GSM irec=irec+1 ! GSM write(17,rec=irec)((mwpl(i,j),i=iw,ie),j=js,jn) ! GSM write(17,rec=irec)((mwpl(i,j),i=iw,ie),j=js,jn) ! GSM irec=irec+1 ! GSM irec=irec+1 ! GSM write(17,rec=irec)((ucmw(i,j),i=iw,ie),j=js,jn) ! GSM write(17,rec=irec)((ucmw(i,j),i=iw,ie),j=js,jn) ! GSM irec=irec+1 ! GSM irec=irec+1 ! GSM write(17,rec=irec)((vcmw(i,j),i=iw,ie),j=js,jn) ! GSM write(17,rec=irec)((vcmw(i,j),i=iw,ie),j=js,jn) ! GSM irec=irec+1 ! GSM irec=irec+1 ! GSM write(17,rec=irec)((cbps(i,j),i=iw,ie),j=js,jn) ! GSM write(17,rec=irec)((cbps(i,j),i=iw,ie),j=js,jn) ! GSM irec=irec+1 ! GSM irec=irec+1 ! GSM write(17,rec=irec)((ctps(i,j),i=iw,ie),j=js,jn) ! GSM write(17,rec=irec)((ctps(i,j),i=iw,ie),j=js,jn) print*, ' 2D irec=',irec-1 print*, ' 2D irec=',irec-1 irec=irec+1 irec=irec+1 do k=kmax,1,-1 do k=kmax,1,-1 write(17,rec=irec)((phi(i,j,k),i=iw,ie),j=js,jn) write(17,rec=irec)((phi(i,j,k),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 enddo enddo do k=kmax,1,-1 do k=kmax,1,-1 write(17,rec=irec)((u(i,j,k),i=iw,ie),j=js,jn) write(17,rec=irec)((u(i,j,k),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 enddo enddo do k=kmax,1,-1 do k=kmax,1,-1 write(17,rec=irec)((v(i,j,k),i=iw,ie),j=js,jn) write(17,rec=irec)((v(i,j,k),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 enddo enddo do k=kmax,1,-1 do k=kmax,1,-1 write(17,rec=irec)((temp(i,j,k),i=iw,ie),j=js,jn) write(17,rec=irec)((temp(i,j,k),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 enddo enddo do k=kmax,1,-1 do k=kmax,1,-1 write(17,rec=irec)((rh(i,j,k),i=iw,ie),j=js,jn) write(17,rec=irec)((rh(i,j,k),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 enddo enddo do k=kmax,1,-1 do k=kmax,1,-1 write(17,rec=irec)((ome(i,j,k),i=iw,ie),j=js,jn) write(17,rec=irec)((ome(i,j,k),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 enddo enddo do k=kmax,1,-1 do k=kmax,1,-1 write(17,rec=irec)((q(i,j,k),i=iw,ie),j=js,jn) write(17,rec=irec)((q(i,j,k),i=iw,ie),j=js,jn) irec=irec+1 irec=irec+1 enddo enddo ! GSM do k=kmax,1,-1 ! GSM do k=kmax,1,-1 ! GSM write(17,rec=irec)((thte(i,j,k),i=iw,ie),j=js,jn) ! GSM write(17,rec=irec)((thte(i,j,k),i=iw,ie),j=js,jn) ! GSM irec=irec+1 ! GSM irec=irec+1 ! GSM enddo ! GSM enddo ! GSM do k=kmax,1,-1 ! GSM do k=kmax,1,-1 ! GSM write(17,rec=irec)((clwt(i,j,k),i=iw,ie),j=js,jn) ! GSM write(17,rec=irec)((clwt(i,j,k),i=iw,ie),j=js,jn) ! GSM irec=irec+1 ! GSM irec=irec+1 ! GSM enddo ! GSM enddo stop stop end program leit end program leit