subroutine run_biascor(mype) !*********************************************************************** ! prgmmr: pondeca org: np20 date: 2008-02-26 ! ! abstract: ! perform a bias update ! ! program history log: ! 2008-02-26 pondeca !*********************************************************************** use mpi implicit none character(60) cgrid include 'param.incl' !Declare local parameter integer(4),parameter::nflds=19 !hardwired ... not so nice. must !adjust as more control variables are added !Declare passed variables integer(4),intent(in)::mype !Declare local variables integer(4) m,n,nx,ny integer(4) jtime(6),nlon,nlat,nsig character*4 cyyyy character*2 cmm,cdd,chh real(4),allocatable,dimension(:,:)::field1,field2,bias real(4) ds real(4) pbiascor,tbiascor,qbiascor,ubiascor,vbiascor,tdbiascor real(4) gustbiascor,visbiascor,pblhbiascor real(4) tcamtbiascor,lcbasbiascor,cldchbiascor real(4) wspdbiascor,mxtmbiascor,mitmbiascor,pmslbiascor,howvbiascor real(4) uwndbiascor,vwndbiascor real(4) sfcr0 real(4) rcoeff(nflds) character(30) astring(nflds),bstring(nflds) logical lbiascor logical mkrjlists logical hwrfblend logical fexist logical use_sfcr0 logical neutral_stability_windfact_2dvar logical use_similarity_2dvar namelist/gridname/cgrid,lbiascor,pbiascor,tbiascor,qbiascor,ubiascor,vbiascor, & tdbiascor,gustbiascor,visbiascor,pblhbiascor, & wspdbiascor,mxtmbiascor,mitmbiascor,pmslbiascor,howvbiascor, & tcamtbiascor,lcbasbiascor,cldchbiascor, & uwndbiascor,vwndbiascor, & mkrjlists,hwrfblend,use_sfcr0,sfcr0, & neutral_stability_windfact_2dvar,use_similarity_2dvar data cgrid/'conus'/ data lbiascor/.false./ data pbiascor/0.0/ data tbiascor/0.0/ data qbiascor/0.0/ data ubiascor/0.0/ data vbiascor/0.0/ data gustbiascor/0.0/ data visbiascor/0.0/ data pblhbiascor/0.0/ data cldchbiascor/0.0/ data wspdbiascor/0.0/ data tdbiascor/0.0/ data mxtmbiascor/0.0/ data mitmbiascor/0.0/ data pmslbiascor/0.0/ data howvbiascor/0.0/ data tcamtbiascor/0.0/ data lcbasbiascor/0.0/ data uwndbiascor/0.0/ data vwndbiascor/0.0/ !==================================================================== !==> get domain global dimensions (nx,ny) !==================================================================== open (55,file='gridname_input',form='formatted') read(55,gridname) close(55) if (mype==0) then print*,'in run_biascor: lbiascor=',lbiascor endif if (.not.lbiascor) return if (mype==0) then print*,'in run_biascor: pbiascor=',pbiascor print*,'in run_biascor: tbiascor=',tbiascor print*,'in run_biascor: qbiascor=',qbiascor print*,'in run_biascor: ubiascor=',ubiascor print*,'in run_biascor: vbiascor=',vbiascor print*,'in run_biascor: gustbiascor=',gustbiascor print*,'in run_biascor: visbiascor=',visbiascor print*,'in run_biascor: pblhbiascor=',pblhbiascor print*,'in run_biascor: cldchbiascor=',cldchbiascor print*,'in run_biascor: wspdbiascor=',wspdbiascor print*,'in run_biascor: tdbiascor=',tdbiascor print*,'in run_biascor: mxtmbiascor=',mxtmbiascor print*,'in run_biascor: mitmbiascor=',mitmbiascor print*,'in run_biascor: pmslbiascor=',pmslbiascor print*,'in run_biascor: howvbiascor=',howvbiascor print*,'in run_biascor: tcamtbiascor=',tcamtbiascor print*,'in run_biascor: lcbasbiascor=',lcbasbiascor print*,'in run_biascor: uwndbiascor=',uwndbiascor print*,'in run_biascor: vwndbiascor=',vwndbiascor endif call domain_dims(cgrid,nx,ny,ds) if (mype==0) then print*,'in run_biascor: cgrid,nx,ny,ds=',trim(cgrid),nx,ny,ds endif rcoeff (1) = pbiascor ; astring (1) = 'pinc' ; bstring (1) = 'bias_psfcgrid' rcoeff (2) = tbiascor ; astring (2) = 'tinc' ; bstring (2) = 'bias_tgrid' rcoeff (3) = qbiascor ; astring (3) = 'qinc' ; bstring (3) = 'bias_qgrid' rcoeff (4) = ubiascor ; astring (4) = 'uinc' ; bstring (4) = 'bias_ugrid' rcoeff (5) = vbiascor ; astring (5) = 'vinc' ; bstring (5) = 'bias_vgrid' rcoeff (6) = gustbiascor ; astring (6) = 'gustinc' ; bstring (6) = 'bias_gust' rcoeff (7) = visbiascor ; astring (7) = 'visinc' ; bstring (7) = 'bias_vis' rcoeff (8) = pblhbiascor ; astring (8) = 'pblhinc' ; bstring (8) = 'bias_pblh' rcoeff (9) = cldchbiascor ; astring (9) = 'cldchinc' ; bstring (9) = 'bias_cldch' rcoeff (10) = wspdbiascor ; astring (10) = 'wspdinc' ; bstring (10) = 'bias_wspd' rcoeff (11) = tdbiascor ; astring (11) = 'tdinc' ; bstring (11) = 'bias_tdgrid' rcoeff (12) = mxtmbiascor ; astring (12) = 'mxtminc' ; bstring (12) = 'bias_mxtm' rcoeff (13) = mitmbiascor ; astring (13) = 'mitminc' ; bstring (13) = 'bias_mitm' rcoeff (14) = pmslbiascor ; astring (14) = 'pmslinc' ; bstring (14) = 'bias_pmsl' rcoeff (15) = howvbiascor ; astring (15) = 'howvinc' ; bstring (15) = 'bias_howv' rcoeff (16) = tcamtbiascor ; astring (16) = 'tcamtinc' ; bstring (16) = 'bias_tcamt' rcoeff (17) = lcbasbiascor ; astring (17) = 'lcbasinc' ; bstring (17) = 'bias_lcbas' rcoeff (18) = uwndbiascor ; astring (18) = 'uwndinc' ; bstring (18) = 'bias_uwnd' rcoeff (19) = vwndbiascor ; astring (19) = 'vwndinc' ; bstring (19) = 'bias_vwnd' !==================================================================== !==> allocate fields !==================================================================== allocate(field1(nx,ny)) allocate(field2(nx,ny)) allocate(bias(nx,ny)) open (52,file='sigges',form='unformatted') open (53,file='siganl',form='unformatted') read(52) jtime,nlon,nlat,nsig read(52) field1,field2! glat,dx read(52) field1,field2! glon,dy if (mype==0) then print*,'in run_biascor / from first guess' print*,'in run_biascor / jtime=',jtime print*,'in run_biascor / nlon,nlat,nsig=',nlon,nlat,nsig print*,'**********************************************' endif read(53) jtime,nlon,nlat,nsig read(53) field1,field2! glat,dx read(53) field1,field2! glon,dy if (mype==0) then print*,'in run_biascor / from analysis' print*,'in run_biascor / jtime=',jtime print*,'in run_biascor / nlon,nlat,nsig=',nlon,nlat,nsig print*,'**********************************************' endif ! !==================================================================== !==>compute bias correction and write out to file !==================================================================== write(cyyyy,"(i4.4)") jtime(1) write(cmm,"(i2.2)") jtime(2) write(cdd,"(i2.2)") jtime(3) write(chh,"(i2.2)") jtime(4) if (mype==0) & open (30,file='rtma_biascor_out.dat_'//cyyyy//cmm//cdd//chh,form='unformatted') !output file inquire(file='rtma_biascor_in.dat',exist=fexist) if(fexist) then open (20,file='rtma_biascor_in.dat',form='unformatted') else if (mype==0) print*,'in run_biascor: lacking input bias file. assume zero input bias' endif do n=1,nflds !order is: p,t,q,u,v,gust,vis,pblh,cldch,wspd,td,mxtm,mitm,pmsl,howv,tcamt,lcbas,uwnd,vwnd bias=0. if (fexist) read(20) bias if (n==6) then !must skip records to get to gust. skip 11 for ges and 11 for anl do m=1,11 read(52) read(53) enddo read(53) endif read(52) field1 read(53) field2 bias = (1.-rcoeff(n))*bias + rcoeff(n)*(field2-field1) if (mype==0) then write(30) bias print*,'in run_biascor:',trim(astring(n)),'","min,max=',minval(field2-field1),maxval(field2-field1) print*,'in run_biascor:',trim(bstring(n)),'","min,max=',minval(bias),maxval(bias) endif if (n==1) then !skip fis read(52) field1 read(53) field2 endif enddo if (mype==0) then if(fexist) close(20) close(30) endif close(52) close(53) deallocate(field1) deallocate(field2) deallocate(bias) end subroutine run_biascor !************************************************************