subroutine derive_xbvar_mpi(cgrid)
!***********************************************************************
! abstract: derive bckg error estimates for non-observed variables (eg.*
! streamfunction and velocity potential) *
! *
! program history log: *
! 2005-10-08 pondeca *
!***********************************************************************
use mpi
use mpitaskmod, only: mype,npe
use mpitaskmod, only: nx => nlon
use mpitaskmod, only: ny => nlat
use controlvars, only: igust,ivis,ipblh,idist, &
iwspd10m,itd2m,imxtm,imitm, &
ipmsl,ihowv,itcamt,ilcbas, &
iuwnd10m,ivwnd10m
implicit none
!Declare passed variables
character(60),intent(in):: cgrid
!Declare local variables
real(4),allocatable,dimension(:,:)::aux
real(4),allocatable,dimension(:,:)::var_u,var_v
real(4),allocatable,dimension(:,:)::field1,field2
real(4) dxx,dyy,qs0
real(4) rinflu,rinflv,rinflt,rinflq,rinflp
real(4) rinflgust,rinflvis,rinflpblh,rinfldist, &
rinflwspd10m,rinfltd2m,rinflmxtm,rinflmitm, &
rinflpmsl,rinflhowv,rinfltcamt,rinfllcbas, &
rinfluwnd10m,rinflvwnd10m
real(4) efold,growthfact
logical fexist
integer(4) i,j,ierror
integer(4) itdiff
namelist/bckgerr_infl/rinflu,rinflv,rinflt,rinflq,rinflp, &
rinflgust,rinflvis,rinflpblh,rinfldist, &
rinflwspd10m,rinfltd2m,rinflmxtm,rinflmitm, &
rinflpmsl,rinflhowv,rinfltcamt,rinfllcbas, &
rinfluwnd10m,rinflvwnd10m, &
itdiff,efold
data rinflu/0.29/
data rinflv/0.29/
data rinflt/1.25/
data rinflq/1.25/
data rinflp/2.0/
data rinflgust/1.0/
data rinflvis/1.0/
data rinflpblh/1.0/
data rinfldist/1.0/
data rinflwspd10m/1.0/
data rinfltd2m/1.0/
data rinflmxtm/1.0/
data rinflmitm/1.0/
data rinflpmsl/1.0/
data rinflhowv/1.0/
data rinfltcamt/1.0/
data rinfllcbas/1.0/
data rinfluwnd10m/1.0/
data rinflvwnd10m/1.0/
data itdiff/1/ !hours
data efold/1.5/ !day-1
if (mype==0) print*,'in derive_xbvar: cgrid is =',trim(cgrid)
if (mype==0) print*,'in derive_xbvar,nx,ny=',nx,ny
!=================================================================
! read in inflation factors for the sqrt of the variances
!=================================================================
inquire(file='bckgerr_infl_input',exist=fexist)
if (fexist) then
open (55,file='bckgerr_infl_input',form='formatted')
read(55,bckgerr_infl)
close(55)
endif
if (mype==0) then
print*,'in derive_xbvar /initial: rinflu,rinflv,rinflt,rinflq,rinflp=',&
rinflu,rinflv,rinflt,rinflq,rinflp
print*,'in derive_xbvar /initial: rinflgust,rinflvis,rinflpblh,rinfldist=', &
rinflgust,rinflvis,rinflpblh,rinfldist
print*,'in derive_xbvar /initial: rinflwspd10m,rinfltd2m,rinflmxtm,rinflmitm=', &
rinflwspd10m,rinfltd2m,rinflmxtm,rinflmitm
print*,'in derive_xbvar /initial: rinflpmsl,rinflhowv,rinfltcamt,rinfllcbas=', &
rinflpmsl,rinflhowv,rinfltcamt,rinfllcbas
print*,'in derive_xbvar /initial: rinfluwnd10m,rinflvwnd10m=',rinfluwnd10m,rinflvwnd10m
print*,'in derive_xbvar: itdiff,efold=',itdiff,efold
endif
if (itdiff .lt. 1) then
growthfact=1.0
else
growthfact=exp((float(itdiff)-1.0)/(efold*24.))
endif
if (mype==0) print*,'in derive_xbvar: growthfact=',growthfact
rinflu=rinflu*growthfact
rinflv=rinflv*growthfact
rinflt=rinflt*growthfact
rinflq=rinflq*growthfact
rinflp=rinflp*growthfact
rinflgust=rinflgust*growthfact
rinflvis=rinflvis*growthfact
rinflpblh=rinflpblh*growthfact
rinfldist=rinfldist*growthfact
rinflwspd10m=rinflwspd10m*growthfact
rinfltd2m=rinfltd2m*growthfact
rinflmxtm=rinflmxtm*growthfact
rinflmitm=rinflmitm*growthfact
rinflpmsl=rinflpmsl*growthfact
rinflhowv=rinflhowv*growthfact
rinfltcamt=rinfltcamt*growthfact
rinfllcbas=rinfllcbas*growthfact
rinfluwnd10m=rinfluwnd10m*growthfact
rinflvwnd10m=rinflvwnd10m*growthfact
if (mype==0) then
print*,'in derive_xbvar /final: rinflu,rinflv,rinflt,rinflq,rinflp=',&
rinflu,rinflv,rinflt,rinflq,rinflp
print*,'in derive_xbvar /final: rinflgust,rinflvis,rinflpblh,rinfldist=', &
rinflgust,rinflvis,rinflpblh,rinfldist
print*,'in derive_xbvar /final: rinflwspd10m,rinfltd2m,rinflmxtm,rinflmitm=', &
rinflwspd10m,rinfltd2m,rinflmxtm,rinflmitm
print*,'in derive_xbvar /final: rinflpmsl,rinflhowv,rinfltcamt,rinfllcbas=', &
rinflpmsl,rinflhowv,rinfltcamt,rinfllcbas
print*,'in derive_xbvar /final: rinfluwnd10m,rinflvwnd10m=',rinfluwnd10m,rinflvwnd10m
endif
!
!=================================================================
! allocate fields
!=================================================================
!
allocate(aux(ny,nx)) !transposed field
allocate(var_u(nx,ny))
allocate(var_v(nx,ny))
allocate(field1(nx,ny))
allocate(field2(nx,ny))
!
!=================================================================
! get estimate of square-root of variance for u, and v:
!=================================================================
!
open (94,file='bckgvar.dat_psi',form='unformatted')
read(94) aux
close(94)
field1=transpose(aux)
open (94,file='bckgvar.dat_chi',form='unformatted')
read(94) aux
close(94)
field2=transpose(aux)
dxx=1.e5 !Consistent with the use of global statistics
dyy=1.e5 !Consistent with the use of global statistics
do j=1,ny
do i=1,nx
var_u(i,j)=(field1(i,j)/dyy+field2(i,j)/dxx)*rinflu
var_v(i,j)=(field1(i,j)/dxx+field2(i,j)/dyy)*rinflv
enddo
enddo
if (mype==0) then
print*,'in derive_xbvar, for u, sqrt(var)min,max=', &
minval(var_u),maxval(var_u)
print*,'in derive_xbvar, for v, sqrt(var)min,max=', &
minval(var_v),maxval(var_v)
open (10,file='bckgvar.dat_u',form='unformatted')
write(10) var_u
close(10)
open (10,file='bckgvar.dat_v',form='unformatted')
write(10) var_v
close(10)
endif
!
!=================================================================
! get estimate of square-root of variance for ps:
!=================================================================
!
open (94,file='bckgvar.dat_ps0',form='unformatted')
read(94) aux
close(94)
field1=transpose(aux)
do j=1,ny
do i=1,nx
field2(i,j)=1000.*field1(i,j)*rinflp
enddo
enddo
if (mype==0) then
print*,'in derive_xbvar, for ps, sqrt(var)min,max=', &
minval(field2),maxval(field2)
open (10,file='bckgvar.dat_ps',form='unformatted')
write(10) field2
close(10)
endif
!
!=================================================================
! get estimate of square-root of variance for q:
!=================================================================
!
open (94,file='bckgvar.dat_pseudorh',form='unformatted')
read(94) aux
close(94)
field1=transpose(aux)
open (94,file='bckg_qsat.dat',form='unformatted')
read(94) field2 !qs(nx,ny). no need to transpose
close(94)
qs0=sum(field2(:,:))/float(nx*ny)
!!!qs0=maxval(field2)! Avoid too small an error value
do j=1,ny
do i=1,nx
field2(i,j)=field1(i,j)*qs0*rinflq
enddo
enddo
if (mype==0) then
print*,'in derive_xbvar,qs0=',qs0
print*,'in derive_xbvar, for q, sqrt(var)min,max=', &
minval(field2),maxval(field2)
open (10,file='bckgvar.dat_q',form='unformatted')
write(10)field2
close(10)
endif
!
!=================================================================
! get estimate of square-root of variance for t:
!=================================================================
!
open (94,file='bckgvar.dat_t0',form='unformatted')
read(94) aux
close(94)
field2=transpose(aux)*rinflt
if (mype==0) then
print*,'in derive_xbvar, for t, sqrt(var)min,max=', &
minval(field2),maxval(field2)
open (10,file='bckgvar.dat_t',form='unformatted')
write(10) field2
close(10)
endif
!
!=================================================================
! get estimate of square-root of variance for gust:
!=================================================================
!
if (igust > 0) then
open (94,file='bckgvar.dat_gust0',form='unformatted')
read(94) aux
close(94)
field2=transpose(aux)*rinflgust
if (mype==0) then
print*,'in derive_xbvar, for gust, sqrt(var)min,max=', &
minval(field2),maxval(field2)
open (10,file='bckgvar.dat_gust',form='unformatted')
write(10) field2
close(10)
endif
endif
!
!=================================================================
! get estimate of square-root of variance for vis:
!=================================================================
!
if (ivis > 0) then
open (94,file='bckgvar.dat_vis0',form='unformatted')
read(94) aux
close(94)
field2=transpose(aux)*rinflvis
if (mype==0) then
print*,'in derive_xbvar, for vis, sqrt(var)min,max=', &
minval(field2),maxval(field2)
open (10,file='bckgvar.dat_vis',form='unformatted')
write(10) field2
close(10)
endif
endif
!
!=================================================================
! get estimate of square-root of variance for pblh:
!=================================================================
!
if (ipblh > 0) then
open (94,file='bckgvar.dat_pblh0',form='unformatted')
read(94) aux
close(94)
field2=transpose(aux)*rinflpblh
if (mype==0) then
print*,'in derive_xbvar, for pbhl, sqrt(var)min,max=', &
minval(field2),maxval(field2)
open (10,file='bckgvar.dat_pblh',form='unformatted')
write(10) field2
close(10)
endif
endif
!
!=================================================================
! get estimate of square-root of variance for dist:
!=================================================================
!
if (idist > 0) then
open (94,file='bckgvar.dat_dist0',form='unformatted')
read(94) aux
close(94)
field2=transpose(aux)*rinfldist
if (mype==0) then
print*,'in derive_xbvar, for dist, sqrt(var)min,max=', &
minval(field2),maxval(field2)
open (10,file='bckgvar.dat_dist',form='unformatted')
write(10) field2
close(10)
endif
endif
!=================================================================
! get estimate of square-root of variance for wspd10m:
!=================================================================
!
if (iwspd10m > 0) then
open (94,file='bckgvar.dat_wspd10m0',form='unformatted')
read(94) aux
close(94)
field2=transpose(aux)*rinflwspd10m
if (mype==0) then
print*,'in derive_xbvar, for wspd10m, sqrt(var)min,max=', &
minval(field2),maxval(field2)
open (10,file='bckgvar.dat_wspd10m',form='unformatted')
write(10) field2
close(10)
endif
endif
!=================================================================
! get estimate of square-root of variance for td2m:
!=================================================================
!
if (itd2m > 0) then
open (94,file='bckgvar.dat_td2m0',form='unformatted')
read(94) aux
close(94)
field2=transpose(aux)*rinfltd2m
if (mype==0) then
print*,'in derive_xbvar, for td2m, sqrt(var)min,max=', &
minval(field2),maxval(field2)
open (10,file='bckgvar.dat_td2m',form='unformatted')
write(10) field2
close(10)
endif
endif
!=================================================================
! get estimate of square-root of variance for mxtm:
!=================================================================
!
if (imxtm > 0) then
open (94,file='bckgvar.dat_mxtm0',form='unformatted')
read(94) aux
close(94)
field2=transpose(aux)*rinflmxtm
if (mype==0) then
print*,'in derive_xbvar, for mxtm, sqrt(var)min,max=', &
minval(field2),maxval(field2)
open (10,file='bckgvar.dat_mxtm',form='unformatted')
write(10) field2
close(10)
endif
endif
!=================================================================
! get estimate of square-root of variance for mitm:
!=================================================================
!
if (imitm > 0) then
open (94,file='bckgvar.dat_mitm0',form='unformatted')
read(94) aux
close(94)
field2=transpose(aux)*rinflmitm
if (mype==0) then
print*,'in derive_xbvar, for mitm, sqrt(var)min,max=', &
minval(field2),maxval(field2)
open (10,file='bckgvar.dat_mitm',form='unformatted')
write(10) field2
close(10)
endif
endif
!=================================================================
! get estimate of square-root of variance for pmsl:
!=================================================================
!
if (ipmsl > 0) then
open (94,file='bckgvar.dat_pmsl0',form='unformatted')
read(94) aux
close(94)
field2=transpose(aux)*rinflpmsl
if (mype==0) then
print*,'in derive_xbvar, for pmsl, sqrt(var)min,max=', &
minval(field2),maxval(field2)
open (10,file='bckgvar.dat_pmsl',form='unformatted')
write(10) field2
close(10)
endif
endif
!=================================================================
! get estimate of square-root of variance for howv:
!=================================================================
!
if (ihowv > 0) then
open (94,file='bckgvar.dat_howv0',form='unformatted')
read(94) aux
close(94)
field2=transpose(aux)*rinflhowv
if (mype==0) then
print*,'in derive_xbvar, for howv, sqrt(var)min,max=', &
minval(field2),maxval(field2)
open (10,file='bckgvar.dat_howv',form='unformatted')
write(10) field2
close(10)
endif
endif
!=================================================================
! get estimate of square-root of variance for tcamt:
!=================================================================
!
if (itcamt > 0) then
open (94,file='bckgvar.dat_tcamt0',form='unformatted')
read(94) aux
close(94)
field2=transpose(aux)*rinfltcamt
if (mype==0) then
print*,'in derive_xbvar, for tcamt, sqrt(var)min,max=', &
minval(field2),maxval(field2)
open (10,file='bckgvar.dat_tcamt',form='unformatted')
write(10) field2
close(10)
endif
endif
!=================================================================
! get estimate of square-root of variance for lcbas:
!=================================================================
!
if (ilcbas > 0) then
open (94,file='bckgvar.dat_lcbas0',form='unformatted')
read(94) aux
close(94)
field2=transpose(aux)*rinfllcbas
if (mype==0) then
print*,'in derive_xbvar, for lcbas, sqrt(var)min,max=', &
minval(field2),maxval(field2)
open (10,file='bckgvar.dat_lcbas',form='unformatted')
write(10) field2
close(10)
endif
endif
!=================================================================
! get estimate of square-root of variance for uwnd10m:
!=================================================================
!
if (iuwnd10m > 0) then
open (94,file='bckgvar.dat_uwnd10m0',form='unformatted')
read(94) aux
close(94)
field2=transpose(aux)*rinfluwnd10m
if (mype==0) then
print*,'in derive_xbvar, for uwnd10m, sqrt(var)min,max=', &
minval(field2),maxval(field2)
open (10,file='bckgvar.dat_uwnd10m',form='unformatted')
write(10) field2
close(10)
endif
endif
!=================================================================
! get estimate of square-root of variance for vwnd10m:
!=================================================================
!
if (ivwnd10m > 0) then
open (94,file='bckgvar.dat_vwnd10m0',form='unformatted')
read(94) aux
close(94)
field2=transpose(aux)*rinflvwnd10m
if (mype==0) then
print*,'in derive_xbvar, for vwnd10m, sqrt(var)min,max=', &
minval(field2),maxval(field2)
open (10,file='bckgvar.dat_vwnd10m',form='unformatted')
write(10) field2
close(10)
endif
endif
!=================================================================
!
call mpi_barrier(mpi_comm_world,ierror)
deallocate(aux)
deallocate(var_u)
deallocate(var_v)
deallocate(field1)
deallocate(field2)
return
end
!*********************************************************************
!*********************************************************************