! -------------------------------------------------------------------------- ! PROGRAMA gera_sondagens ! ! Autor: ERNANI DE LIMA NASCIMENTO ! Data: OUTUBRO de 2006 ! ! Este programa lê arquivo binário do grads gerado pelo script SOUND3.EXEC ! e gera um arquivo de saída ASCII contendo as 3264 sondagens do ETA para o caso ! do tornado de Indaiatuba. A formatação desta saída satisfaz a leitura para ! o programa indices_severos5.f90 ! --------------------------------------------------------------------------- program gera_sondagens IMPLICIT NONE ! Parameter integer, parameter :: Max_Sond_Levs=200 real, parameter :: T0=273.15 ! Parametros do Modelo Passados via namelist integer :: im ! Numero de pontos em x integer :: jm ! Numero de pontos em y integer :: lm ! Numero de niveis integer :: FreqModOut ! Frequencia de saida real :: loni ! Longitude a oeste real :: lati ! Latitude ao sul real :: res ! Resolucao do modelo integer :: idia ! Dia da (passado via namelist) integer :: imes ! Mes (passado via namelist) integer :: iano ! Ano (passado via namelist) integer :: ihora ! Hora (passado via namelist) !____________________________________________________________________________ ! Variaveis integer :: imjm integer :: lmp1 ! Variáveis de trabalho integer :: i,j,k,l,n,irec,geop,lnlev,umrl,strm_opt,ind real :: est, estd,wvmr2m,wvmr,vap real :: mlevs(Max_Sond_Levs) integer, allocatable :: station(:),istart(:),nlev(:) ! Variáveis de entrada integer :: datsav(11),kpds(200) character(len=60) :: ARQIN,ARQOUT character(LEN=12):: atime real, allocatable :: variab(:,:,:) real, allocatable :: lev(:) real, allocatable :: umes(:,:) namelist/model_grids/im,jm,lm,loni,lati,res,FreqModOut, & & idia,imes,iano,ihora,ARQIN,ARQOUT,strm_opt namelist/model_levs/mlevs open(1,file='namelist',form='formatted',status='old') rewind(1) read(1,model_grids) rewind(1) read(1,model_levs) close(1) imjm=im*jm lmp1=lm+1 allocate(lev(lmp1)) n=index(ARQIN,' ')-1 ! ! X and Y dimensions now obtained from the degribbed GRIB file ! im=144 jm=157 imjm=im*jm ALLOCATE(station(imjm),istart(imjm),nlev(imjm)) ALLOCATE(variab(lmp1,10,imjm)) variab=9999. ! write(*,*)idia,imes,iano,ihora & ! & ,ARQIN,ARQOUT,strm_opt ! write(*,*)im,jm,lm,loni,lati,res,FreqModOut,lmp1,imjm lev(1)=9999. lev(2:lmp1)=mlevs(1:lm) ! write(*,*)lev call read_degrib(ARQIN(1:n),imjm,lmp1,variab,atime) ! write(*,*) 'Utilizar deslocamento observado da tempestade? (1=sim 5=não)' ! write(*,*) 'strm_opt ',strm_opt if ((strm_opt /= 1).AND.(strm_opt /= 5)) then write(*,*) 'Opção não disponível. Programa interrompido.' stop endif ! write(*,*)lev call read_degrib(ARQIN(1:n),imjm,lmp1,lev,variab,atime) ! Tranforma Temp (K) => Temp (C) variab(1:lmp1,3,1:imjm)=variab(1:lmp1,3,1:imjm)-T0 variab(1:lmp1,4,1:imjm)=variab(1:lmp1,4,1:imjm)-T0 do k=1, imjm variab(1,9,k)=exp(alog(variab(1,3,k)+T0)+0.286*alog(1000/variab(1,2,k))) est=6.112*exp((17.67*variab(1,3,k))/(variab(1,3,k)+243.5)) estd=6.112*exp((17.67*variab(1,4,k))/(variab(1,4,k)+243.5)) variab(1,5,k)=100*(estd/est) wvmr2m=(0.62197*estd)/(variab(1,2,k)-estd) variab(1,6,k)=wvmr2m*1000 enddo do k=1, imjm do l=2, lmp1 variab(l,2,k)=lev(l) variab(l,9,k)=exp(alog(variab(l,3,k)+T0)+0.286*alog(1000/lev(l))) wvmr=(umes(l,k)/(1-umes(l,k))) vap=(lev(l)*wvmr)/(0.62197+wvmr) variab(l,4,k)=(243.5*alog(vap/6.112))/(17.67-alog(vap/6.112)) variab(l,6,k)=wvmr*1000 enddo enddo ! i= 20 níveis (19 níveis de pressão mais o nível de superfície) ! j= 9 variáveis ! k= 3264 pontos da matriz (64 x 51) ! ! Agora checamos o número de níveis de cada perfil. Isto vai depender de quantos ! níveis estão "abaixo" do solo em cada ponto de grade. A sondagem vai sempre ! começar do nível de superfície, não do nível de 1000hPa. ! do k=1,imjm nlev(k)=0 lnlev=11 do l=12,2,-1 if (variab(1,2,k) > lev(l)) then nlev(k)=lnlev istart(k)=l endif lnlev=lnlev+1 enddo enddo geop=0 umrl=0 ! Definindo po arquivo de saída contendo as sondagens para serem open (3, file='eta.sound.txt', FORM='FORMATTED',status='UNKNOWN') ! station(1)=75000 write(3,299)im,jm,loni,lati,res,FreqModOut,lmp1,strm_opt ind=index(ARQOUT,' ')-1 write(3,*)ARQOUT(1:ind) do k=1,imjm ! Loop pelo número de pontos de grade. write(3,300) station(k),nlev(k),ihora,idia,imes,iano if (nlev(k) == 0) then print*,' Ponto sem sondagem: ', k else geop=nint(variab(1,1,k)) umrl=nint(variab(1,5,k)) ! Escreve o primeiro nível do ponto de grade k (sempre o nível de superfície). write(3,301) variab(1,2,k),geop,variab(1,3,k),variab(1,4,k), & umrl,variab(1,6,k),variab(1,7,k),variab(1,8,k),variab(1,9,k) ! Loop pelo número de níveis do ponto de grade k. do i=istart(k), lmp1 geop=nint(variab(i,1,k)) umrl=nint(variab(i,5,k)) write(3,301) lev(i),geop,variab(i,3,k),variab(i,4,k), & umrl,variab(i,6,k),variab(i,7,k),variab(i,8,k),variab(i,9,k) enddo station(k+1)=station(k)+1 endif enddo 299 format (2(1x,I3),3(1x,f5.1),1x,I2,1x,I3,1x,I2) 300 format (1X,I5,1x,I4,3(1x,I2),1X,I4) 301 format (1X,F7.1,I7,2F7.1,I7,F7.2,2F8.2,F9.3) 305 format (1X,I3) stop ! END OF PROGRAM GERA SONDAGENS end !=============================================================================== ! subroutine read_degrib(etafile,nxny,nz,pr,variab,atime) ! implicit none ! integer nxny,nz,i,datsav,n,l ! real variab(21,10,22608),dummy,pr(nz),tmp(nxny,1),tmp2(nxny) ! integer kgds(200),kpds(50),len,kerr,jpds(200),jgds(200) & & ,lenpds,lenkgds,nwords,kpdsl & & ,j,k,nx,IRETO,KNUM,IRET1 ! character*(*) etafile character(LEN=1):: pds(50) character(LEN=12):: atime character(LEN=2):: gproj logical bitmap(nxny) common /gdsinfo/datsav(11) !_______________________________________________________________________________ ! len=index(etafile//' ',' ')-1 ! ! *** Check that the input dimensions match grib file dimensions. ! ! write(6,*) 'inside read_degrib ' ! write(*,*)nxny,nz ! write(*,*)pr(1:nz) ! Should be able to derive all header info in the DEGRIB file ! from the GDS/PDS of the GRIB file. ! ! ! ! *** Fill time stamp (assume all records are for same time). ! ! *** Fill a missing value flag into first space of each variable. ! ! do n=1, 10 ! do l=1, nz ! do k=1, nxny ! write(*,*)n,l,k,variab(l,n,k) ! enddo ! enddo ! enddo stop ! end !