! -------------------------------------------------------------------------- ! PROGRAMA �dices_severos5 ! ! Autor: ERNANI DE LIMA NASCIMENTO ! Data: Outubro de 2006 ! ! Este programa calcula �dices de tempo severo a partir de perfis ! verticais atmosf�icos gerados por modelos num�icos. ! NOTA 1: ESTA VERS� CALCULA �DICES SEVEROS TERMODIN�ICOS E CINEM�ICOS. ! NOTA 2: ESTA VERS� �ID�TICA �VERS� �dices_severos4, EXCETO QUE L�! UM ARQUIVO DE ENTRADA COM CONTE�O DIFERENTE E GERA UM ARQUIVO ! BIN�IO PARA O GRADS, AL� DO ARQUIVO ASCII PARA O ARPS. ! NOTA 3: ESTA VERS� GERA SA�A DE SONDAGENS EM FORMATO PARA EXECU�O NO ! ARPS. POR EXEMPLO, L�O ARQUIVO eta.sound_0212_0318.txt E GERA ! O ARQUIVO arps.eta.sound_0212_0318.txt. DEPOIS ESTE ARQUIVO ! DEVE SER EDITADO PARA INCLUIR O CABE�LHO DESEJADO E ENT� ! SER SALVO COM EXTENS� .snd PARA SER UTILIZADO COM O ARPS ! (LEIA O ARQUIVO LEIA-ME PARA MAIORES DETALHES). ! ! ! Exemplo de arquivo de entrada necess�io para este programa (este formato ! �aquele gerado pelo programa gera_sond_2.f90): ! ! 78122 20 18 24 05 2005 ! 1000.0 125 25.4 19.7 70 14.65 -1.24 -7.64 298.581 ! 925.0 804 20.3 16.4 79 12.83 -1.26 -7.91 300.023 ! 900.0 1040 18.3 15.0 81 11.97 -1.31 -8.07 300.422 ! 850.0 1528 15.4 11.6 78 10.18 -2.30 -10.65 302.267 ! 800.0 2041 13.0 7.5 69 8.17 -2.44 -10.54 305.057 ! 750.0 2581 9.8 3.8 67 6.72 -1.68 -7.88 307.192 ! 700.0 3151 6.3 0.2 65 5.54 -0.90 -5.52 309.413 ! 650.0 3757 3.1 -4.2 59 4.30 -0.38 -4.89 312.487 ! ! ... .... ... ... ... ... ... ... .... .... .... ! etc..... ! ! O que significa cada nmero no exemplo acima: ! 78122 => identificador da "esta�o" (irrelevante neste programa) ! 20 => nmero de n�eis do perfil ! 18 => hor�io UTC ! 24 => dia ! 05 => m� ! 2005 => ano ! Colunas: press� (hPa), altitude (m), temperatura (C), temperatura do ponto ! de orvalho (C), umidade relativa (%), raz� de mistura (g/kg), componente zonal ! do vento (m/s), componente meridional do vento (m/s), temperatura potencial (K). ! ! ! �dices calculados: CAPE de superf�ie, CAPE com corre�o de water loading, ! indice de levantamento, n�el de condensa�o por levantamento, n�el de convec�o ! espont�ea, inibi�o convectiva, componentes u e v do movimento esperado de tempestades, ! escoamento relativo �tempestade em n�eis baixos e m�ios, helicidade relativa �! tempestade, nmero de Richardson volum�rico, denominador do nmero de Richardson ! volum�rico, �dice de energia-helicidade. ! ! Com exce�o da rotina de c�culo do �dice de energia-helicidade (interiramente nova), ! todas as rotinas foram modificadas a partir do ARPS5.0_IHOP6 e ADAS. ! ! ! --------------------------------------------------------------------------- program indices_severos implicit none ! Vari�eis miscel�eas integer :: i, j, k, nrad, irec,im,jm,ind integer :: lm,m_lm integer*2 :: imes real :: arg, u2dd, v2dd, dd, ff integer :: Freq_Mod_Out real :: loni, lati, res character*2 :: cdia,chora ! Vari�eis de entrada integer :: strm_opt integer, allocatable :: estacao(:), hora(:), dia(:), mes(:), ano(:), nlev(:) integer, allocatable :: altm(:,:), urporc(:,:), dddeg(:,:), vvkt(:,:) real, allocatable :: presshpa(:,:), tc(:,:), tdc(:,:), wvgkg(:,:), presspa(:,:), tk(:,:) real, allocatable :: wvkgkg(:,:), u(:,:), v(:,:), theta(:,:), specif(:,:) ! Vari�eis para os �dices de tempo severo real, allocatable :: cape(:), mcape(:), li(:), ncl(:), nce(:), cin(:), el(:) real, allocatable :: ustrm(:), vstrm(:), llsrm(:), mlsrm(:), heli(:) real, allocatable :: nrv(:), dnrv(:), ieh(:), tcap(:), thetab(:) real, allocatable :: bl(:), shr37(:), blcon(:), sup(:), ffstrm(:), ddstrm(:), dnrv2km(:) character(len=3) :: cmes(12) ! Obs: tcap = lid strength; thetab = twdf on arpsplt.f (max wet bulb potential ! temperature difference) ! ! Vari�eis para c�culos em coluna real, ALLOCATABLE :: p1d(:), ht1d(:), t1d(:), tv1d(:), td1d(:) real, ALLOCATABLE :: wmr1d(:), partem(:), buoy(:), wload(:), mbuoy(:) real, ALLOCATABLE :: pbesnd(:), mbesnd(:) real, ALLOCATABLE :: u1(:), v1(:) ! Vari�el para nome do arquivo de entrada character(len=60) :: inname, outname1, outname2 ! DATA cmes/"Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"/ ! In�io do programa execut�el... ! ! Lendo o arquivo de entrada contendo as sondagens: ! write(*,*) 'Este programa calcula �dices de tempo severo.' ! write(*,*) 'Ernani L. Nascimento (OUT/2006) (modificado do ARPS). ' ! write(*,*) 'Entre com o nome do arquivo de entrada (at�60 caracteres):' open (10,file='eta.sound.txt',status='old') read(10,*) im,jm,loni,lati,res, Freq_Mod_Out, m_lm, strm_opt read(10,*) outname1 ! read(*,*) inname ! write(*,*) 'Utilizar deslocamento observado da tempestade? (1=sim 5=n�)' ! read(*,*) strm_opt ! write(*,*) 'strm_opt=',strm_opt if ((strm_opt /= 1).AND.(strm_opt /= 5)) then write(*,*) 'Op�o n� dispon�el. Programa interrompido.' stop endif nrad=im*jm lm=m_lm+4 ! outname2='arps.'//inname(1:42) ! write(*,*) "Numero de Pontos do Modelo ",nrad ALLOCATE(estacao(nrad),hora(nrad),dia(nrad),mes(nrad),ano(nrad),nlev(nrad)) ALLOCATE(altm(lm,nrad),urporc(lm,nrad),dddeg(lm,nrad),vvkt(lm,nrad)) ALLOCATE(presshpa(lm,nrad),tc(lm,nrad),tdc(lm,nrad),wvgkg(lm,nrad),presspa(lm,nrad), tk(lm,nrad)) ALLOCATE(wvkgkg(lm,nrad),u(lm,nrad),v(lm,nrad),theta(lm,nrad),specif(lm,nrad)) ! Vari�eis para os �dices de tempo severo ALLOCATE(cape(nrad),mcape(nrad),li(nrad),ncl(nrad),nce(nrad),cin(nrad),el(nrad)) ALLOCATE(ustrm(nrad),vstrm(nrad),llsrm(nrad),mlsrm(nrad),heli(nrad)) ALLOCATE(nrv(nrad),dnrv(nrad),ieh(nrad),tcap(nrad),thetab(nrad)) ALLOCATE(bl(nrad),shr37(nrad),blcon(nrad),sup(nrad),ffstrm(nrad),ddstrm(nrad),dnrv2km(nrad)) ALLOCATE(u1(nrad),v1(nrad)) ALLOCATE (p1d(lm),ht1d(lm),t1d(lm),tv1d(lm),td1d(lm)) ALLOCATE (wmr1d(lm),partem(lm),buoy(lm),wload(lm),mbuoy(lm)) ALLOCATE (pbesnd(lm),mbesnd(lm)) do k=1,nrad read (10,*) estacao(k),nlev(k),hora(k),dia(k),mes(k),ano(k) if (nlev(k) /= 0) then do i=1,nlev(k) read (10,*) presshpa(i,k),altm(i,k),tc(i,k),tdc(i,k),urporc(i,k), & wvgkg(i,k),u(i,k),v(i,k),theta(i,k) presspa(i,k)=presshpa(i,k)*100. tk(i,k)=tc(i,k)+273.15 specif(i,k)=(wvgkg(i,k)/1000.)/(1+(wvgkg(i,k)/1000.)) ! print *,'specif(1,k)= ',specif(1,k), k enddo ! write(*,*) k,' ',presspa(1,k) ! As linhas abaixo geram 2 n�eis adicionais na sondagem. O ETA possui 19 n�eis, mas ! para as rodadas do ARPS tornou-se conveniente acrescentar dois n�eis a mais para ! garantir um topo de dom�io mais alto. Estas linhas podem ser convenientemente comentadas. altm(nlev(k)+1,k)=altm(nlev(k),k)+(altm(nlev(k),k)-altm(nlev(k)-1,k)) altm(nlev(k)+2,k)=altm(nlev(k)+1,k)+(altm(nlev(k),k)-altm(nlev(k)-1,k)) specif(nlev(k)+1,k)=specif(nlev(k),k) specif(nlev(k)+2,k)=specif(nlev(k),k) u(nlev(k)+1,k)=u(nlev(k),k) u(nlev(k)+2,k)=u(nlev(k),k) v(nlev(k)+1,k)=v(nlev(k),k) v(nlev(k)+2,k)=v(nlev(k),k) endif ! print *,'presshpa(19,k)= ',presshpa(19,k),' ', k enddo close(10) ! ! if (j==1) then ! write(*,*) 'dddeg(1,k)= ',dddeg(j,k),' para k= ',k ! write(*,*) 'vvmps(1,k)= ',vvmps(j,k),' para k= ',k ! endif ! call ddff2uv(dddeg,vvmps,uu,vv,j) ! ! Transformando graus e magnitude do vento em componentes zonal e meridional ! arg = (dddeg(j,k) * (3.141592654/180.)) ! uu = -vvmps(j,k) * sin(arg) ! vv = -vvmps(j,k) * cos(arg) ! u(j,k)=uu ! v(j,k)=vv ! if (j==1) then ! write(*,*) 'u(1,k)= ',u(j,k),' para k= ',k ! write(*,*) 'v(1,k)= ',v(j,k),' para k= ',k ! endif ! ! Chama rotina de c�culo de �dices termodin�icos ! ! print *,'hgt(m) antes: ', altm(1,1) ! do k=1,nrad ! print *,'presshpa(19,k)= ',presshpa(19,k),' ', k ! enddo ! write(*,*) k,' PASSEI AQUI 1.' call arps_be(nrad,lm,presshpa,altm,tc,tdc,wvgkg,ncl,nce,el,thetab,li,cape, & mcape,cin,tcap,p1d,ht1d,t1d,tv1d,td1d,wmr1d,partem, & buoy,wload,mbuoy,pbesnd,mbesnd,nlev,estacao,hora,dia, & mes,ano) ! ! C�culo de �dices cinem�icos ! ! ! write(*,*) k,' PASSEI AQUI 2' call calcshr(nrad,lm,altm,bl,presspa,tk,u,v,cape,shr37,ustrm,vstrm,llsrm, & mlsrm,heli,nrv,dnrv,dnrv2km,blcon,u1,v1,nlev,estacao,hora,dia, & mes,ano,strm_opt) call calcehi_sup(nrad,lm,nlev,presshpa,cape,heli,dnrv,ieh,sup) ! Arquivo de sa�a: bin�io para o grads ind=index(outname1,' ')-1 open(12,file=outname1,FORM='UNFORMATTED',status='unknown',ACCESS='DIRECT', & recl=nrad*4) ! write(12,*) ' EST UTC DIA M� ANO SHR37 ustrm vstrm ddstrm ffstrm helic BRN BRNSHR B2km IEH SUP' irec=1 do k=1,nrad u2dd=ustrm(k) v2dd=vstrm(k) call uv2ddff(u2dd,v2dd,dd,ff) ddstrm(k)=dd ffstrm(k)=ff enddo irec=1 write(12,rec=irec) (ncl(k),k=1,nrad) irec=irec+1 write(12,rec=irec) (nce(k),k=1,nrad) irec=irec+1 write(12,rec=irec) (el(k),k=1,nrad) irec=irec+1 write(12,rec=irec) (thetab(k),k=1,nrad) irec=irec+1 write(12,rec=irec) (li(k),k=1,nrad) irec=irec+1 write(12,rec=irec) (cape(k),k=1,nrad) irec=irec+1 write(12,rec=irec) (mcape(k),k=1,nrad) irec=irec+1 write(12,rec=irec) (cin(k),k=1,nrad) irec=irec+1 write(12,rec=irec) (shr37(k),k=1,nrad) irec=irec+1 write(12,rec=irec) (ustrm(k),k=1,nrad) irec=irec+1 write(12,rec=irec) (vstrm(k),k=1,nrad) irec=irec+1 write(12,rec=irec) (heli(k),k=1,nrad) irec=irec+1 write(12,rec=irec) (nrv(k),k=1,nrad) irec=irec+1 write(12,rec=irec) (dnrv(k),k=1,nrad) irec=irec+1 write(12,rec=irec) (dnrv2km(k),k=1,nrad) irec=irec+1 write(12,rec=irec) (ieh(k),k=1,nrad) irec=irec+1 write(12,rec=irec) (sup(k),k=1,nrad) ! if ((ieh(k)<-1.0).and.(sup(k)<-1.0)) then ! write(*,*) 'EHI AND SUP LESS THAN -1 (k EHI SUP): ',k,ieh(k),sup(k) ! endif close(12) write(*,*) 'Fim do Processamento' ! Arquivo de sa�a: sondagem com formato para o ARPS ! open(13,file=outname2,status='unknown') ! write(13,304) nrad ! do k=1,nrad ! write(13,300) estacao(k),hora(k),dia(k),mes(k),ano(k) ! write (13,*) ' ZSND THSND QVSND USND VSND ' ! As duas linhas abaixo acrescentam dois n�eis para theta. ! theta(nlev(k)+1,k)=theta(nlev(k),k)+(theta(nlev(k),k)-theta(nlev(k)-1,k)) ! theta(nlev(k)+2,k)=theta(nlev(k)+1,k)+(theta(nlev(k),k)-theta(nlev(k)-1,k)) ! O loop abaixo acrescenta os dois n�eis adicionais para o ARPS. ! do i=1,nlev(k)+2 ! write(13,303) float(altm(nlev(k)+3-i,k)),theta(nlev(k)+3-i,k), & ! & specif(nlev(k)+3-i,k),u(nlev(k)+3-i,k), & ! & v(nlev(k)+3-i,k) ! enddo ! enddo ! close(13) write(cdia(1:2),'(I2)')dia(1) if (dia(1).lt.10) cdia(1:1)='0' write (chora(1:2),'(I2)')hora(1) if (hora(1).lt.10) chora(1:1)='0' open(15,file=outname1(1:ind-4)//'.ctl',status='unknown') write(15,400)outname1 write(15,401) write(15,402) write(15,403)im,loni,res write(15,404)jm,lati,res write(15,405) imes=mes(1) write(15,406)chora(1:2),cdia(1:2),cmes(imes),ano(1),Freq_Mod_Out write(15,407) write(15,408) write(15,409) write(15,410) write(15,411) write(15,412) write(15,413) write(15,414) write(15,415) write(15,416) write(15,417) write(15,418) write(15,419) write(15,420) write(15,421) write(15,422) write(15,423) write(15,424) write(15,425) close(15) 300 format (1X,I5,3I4,I5) 301 format (1X,I5,3I4,I5,F8.1,1X,2F8.1,2F7.1,3F8.1) 302 format (1X,I5,3I4,I5,F8.5,2F7.3,F8.1,F7.1,F9.2,F6.1,2F7.1,2F6.1) 303 format (1X,F9.3,F12.5,F12.8,2F12.5) 304 format (1X,I4) 400 format('DSET ^',A60) 401 format('UNDEF -9999. ') 402 format('TITLE Indices de Tempestades Severas') 403 format('XDEF ',I4,' LINEAR ',f7.3,' ',f8.4) 404 format('YDEF ',I4,' LINEAR ',f7.3,' ',f8.4) 405 format('ZDEF 1 LEVELS 1000 ') 406 format('TDEF 1 LINEAR ',a2,'Z',a2,A3,I4,' ',I2'hr') 407 format('VARS 17') 408 format('ncl 0 99 Nivel de Cond. Levantamento (m)') 409 format('nce 0 99 Nivel de Conv. Espontanea (m)') 410 format('ne 0 99 Nivel de Equilibrio (m)') 411 format('thetab 0 99 Max dif. Temp. Bulbo umido (K)') 412 format('li 0 99 Lifted Index (degree)') 413 format('cape 0 99 CAPE (J/kg)') 414 format('mcape 0 99 CAPE (J/kg)') 415 format('cin 0 99 CINE (J/kg)') 416 format('shr37 0 99 Total 6h Precip. (m)') 417 format('ustrm 0 99 Desl. Esp. da Tempestade (m/s)') 418 format('vstrm 0 99 Desl. Esp. da Tempestade (m/s)') 419 format('heli 0 99 Helicidaade Rel. a Tempestade (m^2/s^2)') 420 format('nrv 0 99 Numero de Richardson Volumetrico ()') 421 format('dnrv 0 99 Den. de Num.de R. Volumetrico (m^2/s^2)') 422 format('dnrv2km 0 99 Den. de Num.de R. V. Cam. 2km (m^2/s^2)') 423 format('ieh 0 99 Indice de Energia-Helicidade ()') 424 format('sup 0 99 Parametro de Super Celula ()') 425 format('ENDVARS') ! stop ! END OF PROGRAM �DICES SEVEROS end