module kinds !$$$ module documentation block ! . . . . ! module: kinds ! prgmmr: treadon org: np23 date: 2004-08-15 ! ! abstract: Module to hold specification kinds for variable declaration. ! This module is based on (copied from) Paul vanDelst's ! type_kinds module found in the community radiative transfer ! model ! ! module history log: ! 2004-08-15 treadon ! 2011-07-04 todling - define main precision during compilation ! ! Subroutines Included: ! ! Functions Included: ! ! remarks: ! The numerical data types defined in this module are: ! i_byte - specification kind for byte (1-byte) integer variable ! i_short - specification kind for short (2-byte) integer variable ! i_long - specification kind for long (4-byte) integer variable ! i_llong - specification kind for double long (8-byte) integer variable ! r_single - specification kind for single precision (4-byte) real variable ! r_double - specification kind for double precision (8-byte) real variable ! r_quad - specification kind for quad precision (16-byte) real variable ! ! i_kind - generic specification kind for default integer ! r_kind - generic specification kind for default floating point ! ! ! attributes: ! language: f90 ! machine: ibm RS/6000 SP ! !$$$ end documentation block implicit none private ! Integer type definitions below ! Integer types integer, parameter, public :: i_byte = selected_int_kind(1) ! byte integer integer, parameter, public :: i_short = selected_int_kind(4) ! short integer integer, parameter, public :: i_long = selected_int_kind(8) ! long integer integer, parameter, private :: llong_t = selected_int_kind(16) ! llong integer integer, parameter, public :: i_llong = max( llong_t, i_long ) ! Expected 8-bit byte sizes of the integer kinds integer, parameter, public :: num_bytes_for_i_byte = 1 integer, parameter, public :: num_bytes_for_i_short = 2 integer, parameter, public :: num_bytes_for_i_long = 4 integer, parameter, public :: num_bytes_for_i_llong = 8 ! Define arrays for default definition integer, parameter, private :: num_i_kinds = 4 integer, parameter, dimension( num_i_kinds ), private :: integer_types = (/ & i_byte, i_short, i_long, i_llong /) integer, parameter, dimension( num_i_kinds ), private :: integer_byte_sizes = (/ & num_bytes_for_i_byte, num_bytes_for_i_short, & num_bytes_for_i_long, num_bytes_for_i_llong /) ! Default values ! **** CHANGE THE FOLLOWING TO CHANGE THE DEFAULT INTEGER TYPE KIND *** integer, parameter, private :: default_integer = 3 ! 1=byte, ! 2=short, ! 3=long, ! 4=llong integer, parameter, public :: i_kind = integer_types( default_integer ) integer, parameter, public :: num_bytes_for_i_kind = & integer_byte_sizes( default_integer ) ! Real definitions below ! Real types integer, parameter, public :: r_single = selected_real_kind(6) ! single precision integer, parameter, public :: r_double = selected_real_kind(15) ! double precision integer, parameter, private :: quad_t = selected_real_kind(20) ! quad precision integer, parameter, public :: r_quad = max( quad_t, r_double ) ! Expected 8-bit byte sizes of the real kinds integer, parameter, public :: num_bytes_for_r_single = 4 integer, parameter, public :: num_bytes_for_r_double = 8 integer, parameter, public :: num_bytes_for_r_quad = 16 ! Define arrays for default definition integer, parameter, private :: num_r_kinds = 3 integer, parameter, dimension( num_r_kinds ), private :: real_kinds = (/ & r_single, r_double, r_quad /) integer, parameter, dimension( num_r_kinds ), private :: real_byte_sizes = (/ & num_bytes_for_r_single, num_bytes_for_r_double, & num_bytes_for_r_quad /) ! Default values ! **** CHANGE THE FOLLOWING TO CHANGE THE DEFAULT REAL TYPE KIND *** !#ifdef _REAL4_ integer, parameter, private :: default_real = 1 ! 1=single, !#endif !#ifdef _REAL8_ ! integer, parameter, private :: default_real = 2 ! 2=double, !#endif !#ifdef _REAL16_ ! integer, parameter, private :: default_real = 3 ! 3=quad !#endif integer, parameter, public :: r_kind = real_kinds( default_real ) integer, parameter, public :: num_bytes_for_r_kind = & real_byte_sizes( default_real ) end module kinds PROGRAM read_rad ! ! This is to read GSI radiance diagnositic data from subroutine setuprad.f90 ! ! ! Here is code in setuprad.f90 that write out diagnostic information ! ! write(14) isis,dplat(is),obstype,jiter,nchanl,npred,idate,ireal,ipchan,iextra,jextra ! do i=1,nchanl ! write(14)freq4,pol4,wave4,varch4,tlap4,iuse_rad(n),nuchan(n),ich(i) ! end do ! ! if (.not.lextra) then ! write(14) diagbuf,diagbufchan ! else ! write(14) diagbuf,diagbufchan,diagbufex ! endif ! ! diagbuf(1) = cenlat ! observation latitude (degrees) ! diagbuf(2) = cenlon ! observation longitude (degrees) ! diagbuf(3) = zsges ! model (guess) elevation at observation location ! ! diagbuf(4) = dtime ! observation time (hours relative to analysis time) ! ! diagbuf(5) = data_s(iscan_pos,n) ! sensor scan position ! diagbuf(6) = zasat*rad2deg ! satellite zenith angle (degrees) ! diagbuf(7) = data_s(ilazi_ang,n) ! satellite azimuth angle (degrees) ! diagbuf(8) = pangs ! solar zenith angle (degrees) ! diagbuf(9) = data_s(isazi_ang,n) ! solar azimuth angle (degrees) ! diagbuf(10) = sgagl ! sun glint angle (degrees) (sgagl) ! ! diagbuf(11) = surface(1)%water_coverage ! fractional coverage by water ! diagbuf(12) = surface(1)%land_coverage ! fractional coverage by land ! diagbuf(13) = surface(1)%ice_coverage ! fractional coverage by ice ! diagbuf(14) = surface(1)%snow_coverage ! fractional coverage by snow ! diagbuf(15) = surface(1)%water_temperature ! surface temperature over water (K) ! diagbuf(16) = surface(1)%land_temperature ! surface temperature over land (K) ! diagbuf(17) = surface(1)%ice_temperature ! surface temperature over ice (K) ! diagbuf(18) = surface(1)%snow_temperature ! surface temperature over snow (K) ! diagbuf(19) = surface(1)%soil_temperature ! soil temperature (K) ! diagbuf(20) = surface(1)%soil_moisture_content ! soil moisture ! diagbuf(21) = surface(1)%land_type ! surface land type ! diagbuf(22) = surface(1)%vegetation_fraction ! vegetation fraction ! diagbuf(23) = surface(1)%snow_depth ! snow depth ! diagbuf(24) = surface(1)%wind_speed ! surface wind speed (m/s) ! ! if (.not.microwave) then ! diagbuf(25) = cld ! cloud fraction (%) ! diagbuf(26) = cldp ! cloud top pressure (hPa) ! else ! diagbuf(25) = clw ! cloud liquid water (kg/m**2) ! diagbuf(26) = tpwc ! total column precip. water (km/m**2) ! endif ! ! do i=1,nchanl ! diagbufchan(1,i)=tb_obs(i) ! observed brightness temperature (K) ! diagbufchan(2,i)=tbc(i) ! observed - simulated Tb with bias corrrection (K) ! diagbufchan(3,i)=tbcnob(i) ! observed - simulated Tb with no bias correction (K) ! errinv = sqrt(varinv(i)) ! diagbufchan(4,i)=errinv ! inverse observation error ! useflag=one ! if (iuse_rad(ich(i))/=1) useflag=-one ! diagbufchan(5,i)= id_qc(i)*useflag! quality control mark or event indicator ! ! diagbufchan(6,i)=emissivity(i) ! surface emissivity ! diagbufchan(7,i)=tlapchn(i) ! stability index ! do j=1,npred+1 ! diagbufchan(7+j,i)=predterms(j,i) ! Tb bias correction terms (K) ! end do ! end do ! ! ! use kinds, only: r_kind,r_single,i_kind ! implicit none ! ! read in variables ! character(10) :: obstype character(20) :: isis character(10) :: dplat integer(i_kind) :: jiter integer(i_kind) :: nchanl integer(i_kind) :: npred integer(i_kind) :: idate integer(i_kind) :: ireal integer(i_kind) :: ipchan integer(i_kind) :: iextra,jextra real(r_single) :: freq4,pol4,wave4,varch4,tlap4 integer(i_kind) :: iuse_rad integer(i_kind) :: nuchan integer(i_kind),allocatable :: ich(:) ! nchanl integer(i_kind) :: ifirst real(r_single),allocatable,dimension(:,:):: diagbufchan ! ipchan+npred+1,nchanl real(r_single),allocatable,dimension(:):: diagbuf ! ireal real(r_single),allocatable,dimension(:):: simulat ! bbs real(r_single),allocatable,dimension(:,:):: diagbufex !lggg max weight function max value real(r_single),allocatable,dimension(:,:):: diagbufex_pr !lggg real(r_single),allocatable,dimension(:,:):: diagbufex_lev !BBS real(r_single),allocatable,dimension(:,:):: diagbufex_wf !BBS integer, allocatable,dimension(:):: chancon,totalchan, assimcont, rejcont real(r_single),allocatable,dimension(:) :: OMFSOMA, OMFMEDIA, OMFNOBIAS, OMFNOBM real(r_single),allocatable,dimension(:) :: BTSOMUSE,BTSOMNO, BTSOMUSEM, BTSOMNOM real, allocatable, dimension(:) :: iuse_chan, freq_chan,pol_chan,wave_chan real, allocatable, dimension(:) ::varch_chan,tlap_chan,nuchan_chan integer, allocatable, dimension(:) :: radobs,OMFwbc,OMFnbc,iobser,qcmark,sfcems,stbind !!!Declaracao das informacoes do namelist INTEGER :: k, i, j, cont, n, num, m, nobs !contadores INTEGER, DIMENSION(7) :: nchannel !numero totais de arquivos bufr e canais INTEGER :: nmax_sat, nmax_inst !(variaveis fixas que estao no namelist) INTEGER ::iunit=35 !unidade de leitura INTEGER ::junit=36 !unidade de leitura CHARACTER(len=10),DIMENSION(7) :: Sat_name, isnt_name !nomes do sat e instrumentos identificados pelo CRTM CHARACTER(len = 20),DIMENSION(280) :: Sensor_ID CHARACTER(len=20),ALLOCATABLE,DIMENSION(:) :: sensat, sen_sat !todos os numero possiveis dos arquivos !CHARACTER( len=200 ), ALLOCATABLE :: filename (:) !utilizado para montar o nome que a subrotina open_bufr LOGICAL :: ex !variavel utilizada para identificar a existencia do arquivo CHARACTER (len=256) ::CARG CHARACTER (len=6) :: date CHARACTER (len=2) :: day CHARACTER (len=2) :: hour CHARACTER (len=132) :: Pathin CHARACTER (len=132) :: Pathout CHARACTER (len=3) :: arq CHARACTER (len=10) :: obsread CHARACTER (len=10) :: obsthin CHARACTER (len=10) :: obsassim CHARACTER (len=10),dimension(3) :: obsarqu real :: Tim integer :: Lev integer :: Flag ! ! output variables ! ! real :: rlat,rlon,rprs,rdhr,scanp ! real :: satzen,sataz,sunzen,sunaz ! real :: sungl,fcwat,fcland,fcice ! real :: rfcsno,stwat,stland,stice ! real :: stsnow,soilt,soilq,sldtyp ! real :: vegfrc,snowdp,swinds ! real :: cloudf,cloutp,fcsno real :: chan ! ! misc. ! character(10) :: cipe,cloop character(20) :: this_instrument character :: ch integer :: ipe,ios, iloop, iinstrument integer :: ic, iflg,totalcont,rejtotal, assimtotal ! namelist files ! character(180), allocatable, dimension(:) :: infilename,infile,infilei, binfilename, ctlfile, mapfile ! file from GSI running directory character(180), allocatable, dimension(:) :: outfilename, outfile, outfilei, fortfile, contfile ! file name saving results character(180), allocatable, dimension(:) :: omfbcfile, omfnbfile, assimfile ! file name saving results ! namelist/iosetup/ infilename,outfilename NAMELIST /n_Satellites/ nmax_sat,nmax_inst NAMELIST /Selectsat/ Sat_name NAMELIST /Instruments_Name/ isnt_name,nchannel NAMELIST /Path_sat/ Pathin, Pathout !Le os arquivos do namelist OPEN (16,file='../util/conf/id_sat.nml') READ (16,nml= n_Satellites ) READ (16,nml= Instruments_Name ) READ (16,nml= Selectsat) READ (16,nml= Path_sat) !!Lendo argumentos call getarg(1,CARG) read(CARG,*)date call getarg(2,CARG) read(CARG,*)day call getarg(3,CARG) read(CARG,*)hour call getarg(4,CARG) read(CARG,*)arq ! call getarg(5,CARG) ! read(CARG,*)obsread ! call getarg(6,CARG) ! read(CARG,*)obsthi ! call getarg(7,CARG) ! read(CARG,*)obsassim !!Monta o nome dos satelites a partir do id_sat.nml cont=1 DO i=1,nmax_sat DO j=1,nmax_inst Sensor_ID(cont)= TRIM(isnt_name(j))//TRIM(Sat_name(i)) cont=cont+1 ENDDO ENDDO !cptec.diag_amsua_n15_ges.20120813_00z.bin ! ! ! read diag for this_instrument ! allocate(infile(cont)) allocate(infilei(cont)) allocate(outfile(cont)) allocate(outfilei(cont)) allocate(sensat(cont)) !Verifica se os arquivos existem e o numero total de satelitexsensores que estao sendo utilizados num=1 do j=1, cont infile(j)='cptec.diag_'//trim(Sensor_ID(j))//'_'//trim(arq)//'.'//trim(date)//trim(day)//'_'//trim(hour)//'z.bin' outfile(j)= 'cptec.diag_'//trim(Sensor_ID(j))//'_'//trim(arq)//'.'//trim(date)//trim(day)//'_'//trim(hour)//'z' INQUIRE(FILE=trim(Pathin)//trim(date)//trim(day)//trim(hour)//'/diag/'//trim(infile(j)),EXIST=ex) IF(ex) THEN ! write(*,*)'file exist:', infile(j) infilei(num)=trim(infile(j)) outfilei(num)=trim(outfile(j)) sensat(num)=trim(Sensor_ID(j)) num=num+1 ELSE write(*,*)'file does not exist:', trim(Pathin)//trim(date)//trim(day)//trim(hour)//'/diag/'//trim(infile(j)) cycle ENDIF enddo !!Aloca os vetores com o nome dos sensores do tamanho certo allocate(infilename(num-1)) allocate(outfilename(num-1)) allocate(binfilename(num-1)) allocate(ctlfile(num-1)) allocate(mapfile(num-1)) allocate(fortfile(num-1)) allocate(sen_sat(num-1)) allocate(omfbcfile(num-1)) allocate(omfnbfile(num-1)) allocate(assimfile(num-1)) allocate(contfile(num-1)) do j=1,num-1 infilename(j)=trim(infilei(j)) outfilename(j)=trim(outfilei(j))//'.txt' binfilename(j)=trim(outfilei(j))//'.out' ctlfile(j)=trim(outfilei(j))//'.ctl' mapfile(j)=trim(outfilei(j))//'.map' fortfile(j)=trim(outfilei(j))//'.dat' sen_sat(j)=trim(sensat(j)) omfbcfile(j)='omfb_'//trim(sensat(j))//'_'//trim(arq)//'.txt' omfnbfile(j)='omfnb_'//trim(sensat(j))//'_'//trim(arq)//'.txt' assimfile(j)='assim_'//trim(sensat(j))//'_'//trim(arq)//'.txt' contfile(j)='cont_'//trim(sensat(j))//'_'//trim(arq)//'.txt' enddo !WRITE(18,'(A12,A20,A10,4A10)')'Data', 'SENSat', 'Arquivo','TOTAL', 'THINNING','ASSIM', 'REJECT' !Abre os arquivos e le o conteudo e escreve em um arquivo de texto n=0 do j=1,num-1 n=j+30 !! Arquivo gerado que contem as informacoes em ponto de estacao do diagnostico das observacoes OPEN(UNIT=10,FILE=trim(Pathout)//trim(date)//'/'//trim(day)//trim(hour)//'/rad/'//trim(binfilename(j)), & FORM='UNFORMATTED', STATUS='UNKNOWN') !! Arquivo ctl gerado para abrir os arquivos em ponto estacao OPEN(UNIT=15,FILE=trim(Pathout)//trim(date)//'/'//trim(day)//trim(hour)//'/rad/'//trim(ctlfile(j)), & FORM='FORMATTED', STATUS='UNKNOWN') !! Arquivo gerado que contem a media global de OMF/OMA com bias correction OPEN(UNIT=20, FILE=trim(Pathout)//'/temporal/rad/'//trim(omfbcfile(j)),position='append') !! Arquivo gerado que contem a media global de OMF/OMA sem bias correction OPEN(UNIT=21, FILE=trim(Pathout)//'/temporal/rad/'//trim(omfnbfile(j)), position='append') !! Arquivo gerado que contem o numero de observacoes assimiladas por canal OPEN(UNIT=22, FILE=trim(Pathout)//'/temporal/rad/'//trim(assimfile(j)),position='append') !! Arquivo gerado que contem a contagem do numero do obs que entram no sistema, que passam pelo thinning, que sao assimiladas e rejeitas OPEN(UNIT=18, FILE=trim(Pathout)//'/temporal/rad/'//trim(contfile(j)), & FORM='FORMATTED',STATUS='UNKNOWN', position= 'append') !! Arquivo gerado que contem utilizados para gerar o scatter plot no gnuplot OPEN(j+60, FILE=trim(Pathout)//trim(date)//'/'//trim(day)//trim(hour)//'/rad/'//trim(outfilename(j))) !! Arquivo que eh somente lido que contem informacoes de contagem do fort.207 OPEN(UNIT=17, FILE=trim(Pathout)//trim(date)//'/'//trim(day)//trim(hour)//'/rad/'//trim(fortfile(j)), & FORM='FORMATTED') !! Arquivo que eh lido e eh saida do GSI, contem os diagnosticos das observacoes com relacao ao BK e a ANL OPEN(n,FILE=trim(Pathin)//trim(date)//trim(day)//trim(hour)//'/diag/'//trim(infilename(j)),STATUS='OLD', & IOSTAT=ios,ACCESS='SEQUENTIAL', FORM='UNFORMATTED', CONVERT='SWAP') write(*,*)'open file',' ',trim(infilename(j)) if(ios > 0 ) then write(*,*) ' no diag file availabe :', trim(infilename(j)) endif read(n)isis,dplat,obstype,jiter,nchanl,npred,idate,ireal,ipchan,iextra,jextra allocate(ich(nchanl)) allocate(iuse_chan(nchanl)) allocate(freq_chan(nchanl)) allocate(pol_chan(nchanl)) allocate(wave_chan(nchanl)) allocate(varch_chan(nchanl)) allocate(tlap_chan(nchanl)) allocate(nuchan_chan(nchanl)) allocate(totalchan(nchanl)) allocate(assimcont(nchanl)) allocate(rejcont(nchanl)) allocate(OMFSOMA(nchanl)) allocate(OMFNOBIAS(nchanl)) allocate(OMFMEDIA(nchanl)) allocate(OMFNOBM(nchanl)) allocate(BTSOMUSE(nchanl)) allocate(BTSOMNO(nchanl)) allocate(BTSOMUSEM(nchanl)) allocate(BTSOMNOM(nchanl)) rejcont(:)=0 assimcont(:)=0 totalcont=0 assimtotal=0 rejtotal=0 totalchan(:)=0 OMFSOMA(:)=0 OMFMEDIA(:)=0 OMFNOBIAS(:)=0 OMFNOBM(:)=0 BTSOMUSE(:)=0 BTSOMNO(:)=0 BTSOMUSEM(:)=0 BTSOMNOM(:)=0 do i=1,nchanl read(n) freq4,pol4,wave4,varch4,tlap4,iuse_rad,nuchan,ich(i) iuse_chan(i)=iuse_rad freq_chan(i)=freq4 pol_chan(i)=pol4 wave_chan(i)=wave4 varch_chan(i)=varch4 tlap_chan(i)=tlap4 nuchan_chan(i)=nuchan end do allocate(diagbufchan(ipchan+npred+2,nchanl)) allocate(diagbuf(ireal)) allocate(diagbufex(iextra,jextra)) nobs=0 Tim = 0.0 Lev = nchanl Flag = 0 ! Obs: os niveis sao utilizados para gravar os dados por canais, portanto, cada nivel no arquivo do GrADS e' um canal diferente ! iniciando no nivel 1 ate' o numero total de canais. Portanto, para visualizar os dados � necessario fazer um SET Z LEVEL, onde LEVEL seria ! o canal desejado (1,2,3...,nchanl). 100 continue ! Escrevendo os arquivos binários na forma de arquivos de estação para serem lidos no GrADS read(n, ERR=999,end=110) diagbuf,diagbufchan,diagbufex nobs=nobs+1 WRITE(10)& 'satinfos',& diagbuf(1),& diagbuf(2),& Tim, & Lev, & Flag WRITE(10)(real(m), diagbuf(1:26), diagbufchan(1:7,m),diagbufex(1,m),iuse_chan(m),freq_chan(m),nuchan_chan(m),m=1, nchanl) !!!Realizando a contagem dos dados assimilados por canais e por sensor, dos dados rejeitados do i=1, nchanl totalchan(i)=totalchan(i) +1 totalcont=totalcont+1 if (diagbufchan(5,i).eq.0 .and.iuse_chan(i).ge.0)then assimcont(i)= assimcont(i) +1 assimtotal=assimtotal+1 else rejcont(i)=rejcont(i)+1 rejtotal=rejtotal+1 endif enddo !Escrevendo no arquivo utilizado para gerar o scatter ploter do i=1, nchanl if (diagbufchan(5,i).eq.0 .and.iuse_chan(i).ge.1)then write(j+60,*)& i,nuchan_chan(i),diagbuf(1),diagbuf(2),diagbufchan(1,i),diagbufchan(2,i),diagbufchan(3,i) OMFSOMA(i)= diagbufchan(2,i)+OMFSOMA(i) OMFNOBIAS(i)=diagbufchan(3,i)+OMFNOBIAS(i) BTSOMUSE(i)=diagbufchan(1,i)+BTSOMUSE(i) else BTSOMNO(i)=diagbufchan(1,i)+BTSOMNO(i) endif end do !! Realizando o calculo do OMF/OMA medio com e sem bias correction do i=1, nchanl if(assimcont(i).gt.0 .and. iuse_chan(i).ge.1)then OMFMEDIA(i)= OMFSOMA(i)/assimcont(i) OMFNOBM(i)=OMFNOBIAS(i)/assimcont(i) BTSOMUSEM(i)=BTSOMUSE(i)/assimcont(i) BTSOMNOM(i)=BTSOMNO(i)/rejcont(i) else OMFMEDIA(i)= 0 OMFNOBM(i)=0 BTSOMNOM(i)=BTSOMNO(i)/rejcont(i) endif enddo goto 100 ! goto another record 110 continue WRITE(10)' ENDFILE',0.0,0.0,0.0,0,1 ! Fim da escrita dos arquivos de estaçao ! Escrevendo o arquivo ctl (descritos do grads) WRITE(15,*)'dset ^',trim(binfilename(j)) WRITE(15,*)'DTYPE station' WRITE(15,*)'OPTIONS SEQUENTIAL' WRITE(15,*)'STNMAP ^',trim(mapfile(j)) WRITE(15,*)'UNDEF -999.9' WRITE(15,*)'TITLE Station Data Sample' WRITE(15,*)'TDEF 1 linear 12z18jan1992 12hr' WRITE(15,*)'VARS 37' WRITE(15,*)'rlat 1 99 observation latitude (degrees)' WRITE(15,*)'rlon 1 99 observation longitude (degrees)' WRITE(15,*)'rprs 1 99 observation pressure (hPa)' WRITE(15,*)'rdhr 1 99 obs time (hours relative to analysis time)' WRITE(15,*)'scanp 1 99 sensor scan position' WRITE(15,*)'satzen 1 99 satellite zenith angle (degrees)' WRITE(15,*)'sataz 1 99 satellite azimuth angle (degrees)' WRITE(15,*)'sunzen 1 99 solar zenith angle (degrees)' WRITE(15,*)'sunaz 1 99 solar azimuth angle (degrees)' WRITE(15,*)'sungl 1 99 sun glint angle (degrees) (sgagl)' WRITE(15,*)'fcwat 1 99 fractional coverage by water' WRITE(15,*)'fcland 1 99 fractional coverage by land' WRITE(15,*)'fcice 1 99 fractional coverage by ice' WRITE(15,*)'fcsno 1 99 fractional coverage by snow' WRITE(15,*)'stwat 1 99 surface temperature over water (K)' WRITE(15,*)'stland 1 99 surface temperature over land (K)' WRITE(15,*)'stice 1 99 surface temperature over ice (K)' WRITE(15,*)'stsnow 1 99 surface temperature over snow (K)' WRITE(15,*)'soilt 1 99 soil temperature (K)' WRITE(15,*)'soilq 1 99 soil moisture' WRITE(15,*)'sldtyp 1 99 surface land type' WRITE(15,*)'vegfrc 1 99 vegetation fract' WRITE(15,*)'snowdp 1 99 snow depth' WRITE(15,*)'swinds 1 99 surface wind speed (m/s)' WRITE(15,*)'cloudf 1 99 cloud fraction (%)' WRITE(15,*)'cloutp 1 99 cloud top pressure (hPa)' WRITE(15,*)'radobs 1 99 observed brightness temperature (K)' WRITE(15,*)'OMFwbc 1 99 observed - simulated Tb with bias corrrection (K)' WRITE(15,*)'OMFnbc 1 99 observed - simulated Tb with no bias correction (K)' WRITE(15,*)'iobser 1 99 inverse observation error' WRITE(15,*)'qcmark 1 99 quality control mark or event indicator' WRITE(15,*)'sfcems 1 99 surface emissivity' WRITE(15,*)'stbind 1 99 stability index' WRITE(15,*)'wgfun 1 99 pressure where weighting functions is max (hPa)' WRITE(15,*)'iusemk 1 99 iuse, 1=use and -1=monitoring' WRITE(15,*)'freq 1 99 freq GHz' WRITE(15,*)'rchan 1 99 real channel number' WRITE(15,*)'ENDVARS' ! Lendo o arquivo que contem informacoes do fort.207, saida GSI ! READ(17,'(A10)')obsarqu !!Escrita do arquivo que contem a contaagem DATA SENSOR ges/anl DADOS_LIDOS DADOS_thinning DADOS_ASSIM DADOS_REJ ! WRITE(18,'(A20,A10,3A10,I10)'),trim(sen_sat(j)), '1',trim(obsarqu(1)) ,trim(obsarqu(2)) ,trim(obsarqu(3)) , rejtotal ! WRITE(18,'(A20,A10,A10,3I10)')trim(sen_sat(j)),'2',trim(obsarqu(1)),totalcont ,assimtotal , rejtotal ! WRITE(18,'(A12,A20,A10,3A10,I10)')trim(date)//trim(hour),trim(sen_sat(j)), '1',trim(obsarqu(1)) , & ! trim(obsarqu(2)) ,trim(obsarqu(3)), rejtotal WRITE(18,'(A12,A20,A10,A10,3I10)')trim(date)//trim(day)//trim(hour),trim(sen_sat(j)),trim(arq),trim(obsarqu(1)), & totalcont ,assimtotal , rejtotal ! Escrita do arquivo que contem o OMF/OMA medio com bias. ! do i=1, nchanl WRITE(20,* ),trim(date)//trim(day)//trim(hour),(OMFMEDIA(i),i=1,nchanl) ! end do ! Escrita do arquivo que contem o OMF/OMA medio sem bias correction. WRITE(21,* ),trim(date)//trim(day)//trim(hour),(OMFNOBM(i),i=1,nchanl) ! Escrita do arquivo que contem o numero de dados assimilados por canal. WRITE(22,*), trim(date)//trim(day)//trim(hour),(assimcont(i),i=1,nchanl) ! enddo CLOSE(n) CLOSE(10) deallocate(diagbufchan,diagbuf,diagbufex) deallocate(ich) deallocate(iuse_chan,freq_chan,pol_chan) deallocate(wave_chan,varch_chan,tlap_chan,nuchan_chan) deallocate(totalchan,assimcont,rejcont) deallocate(OMFSOMA,OMFMEDIA,OMFNOBIAS) deallocate(BTSOMUSE,BTSOMNO,OMFNOBM) deallocate(BTSOMUSEM,BTSOMNOM) CLOSE(15) ! CLOSE(16) CLOSE(j+60) CLOSE(17) CLOSE(20) CLOSE(18) enddo ! print*,'soma:', OMFMEDIA(:) ! print*,'media:', OMFNOBM(:) deallocate(infile) deallocate(infilei) deallocate(outfile) deallocate(outfilei) deallocate(infilename) deallocate(outfilename) deallocate(binfilename) deallocate(ctlfile) deallocate(fortfile) deallocate(omfbcfile) deallocate(omfnbfile) deallocate(assimfile) deallocate(contfile) deallocate(sensat,sen_sat) ! deallocate(OMFSOMA,OMFMEDIA,OMFNOBIAS) ! deallocate(BTSOMUSE,BTSOMNO) ! deallocate(BTSOMUSEM,BTSOMNOM) STOP 9999 999 PRINT *,'error read in diag file' stop 1234 END PROGRAM read_rad