!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
! version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
!
subroutine readcorns_min 3,10
*
#if defined (DOC)
*
*Author : Luc Fillion - 9 Mar 2009.
*Revision:
* Luc Fillion - 12 Jan 2010: Reading of array mbandsp restricted to "LU" grd_typ. The global spectral
* approach could be wextended to have its own mbandsp prepared by the stats
* program and read here so as to ensure proper use of available spectral stats.
* Luc Fillion - 13 may 2010: Limit printout to processor 0.
*
* -------------------
** Purpose:
*Arguments
#endif
USE procs_topo
IMPLICIT NONE
*implicits
*
* Global variables
*
#include "taglam4d.cdk"
#include "pardim.cdk"
#include "comdim.cdk"
#include "comcva.cdk"
#include "comlun.cdk"
#include "comcorr.cdk"
#include "comstate.cdk"
#include "compstat.cdk"
#include "comfftla.cdk"
#include "comgdpar.cdk"
#include "comcse1.cdk"
#include "comgrd_param.cdk"
!
logical llout,llprint
integer istdkey,icornskey,iuleigen,jk,j1,j2,jn
integer ilen,jcol,jrow,jlevo,jlevi
integer idum1,idum2,idum3,idum4
real*8 zmin,zmax
real*8 zmbandsp(nbandmax)
real*8 zwork,zsum
real*8 zstdsrc(nksdim2)
real*8 zcornssrc(nksdim2,nksdim2)
real*8 zspdev(nband)
!
integer jband,index,ilev
!
#include "rpnstd.cdk"
!
!!
if(myid == 0) write(nulout,*) 'readcorns_min: active='
!
llprint = .true.
llout = .false.
!
if(grd_typ.eq.'LU') then ! done only for LAM case
!
!0. Read the vector of spectral bands contained on statistics file
! Ensure nband and spectral trunctation in stats are the same
! (until further extension to allow this case)
! --------------------------------------------------------------
!
idateo = -1
cletiket = 'MBANDSP '
ip1 = -1
ip2 = -1
ip3 = -1
cltypvar = ' '
clnomvar = ' '
istdkey = vfstlir(zmbandsp,nulbgst,INI,INJ,INK,idateo,cletiket,
& ip1,ip2,ip3,cltypvar,clnomvar)
!
IF(myid == 0) THEN
write(nulout,*) 'readcorns_min: apres vfstlir MBANDSP: INI,INJ,INK=',
& INI,INJ,INK
endif
!
if(nband.ne.INI) then
write(nulout,*) 'readcorns_min: Warning!!!!! truncation here and on stats file different'
! call abort3d(nulout
! & ,'readcorns_min: Problem with specification of 3DVAR value NTRUNCINC')
endif
endif
!
!1. Read the RSTDDEV spectral coefficients
! --------------------------------------
!
! RSTDDEV
do jband = 1, nband
idateo = -1
cletiket = 'RSTDDEV'
ip1 = -1
ip2 = jband-1
ip3 = -1
cltypvar = ' '
clnomvar = ' '
istdkey = vfstlir(zstdsrc,nulbgst,INI,INJ,INK,idateo,cletiket,
& ip1,ip2,ip3,cltypvar,clnomvar)
IF(myid == 0) write(nulout,*) 'readcorns_min: RSTDDEV: INI,INJ,INK=',INI,INJ,INK
!
if(istdkey .lt.0 ) then
IF(myid == 0) THEN
write(nulout,*) 'readcorns_min: RSTDDEV: nulbgst=',nulbgst
write(nulout,*) 'readcorns_min: RSTDDEV: idateo=',idateo
write(nulout,*) 'readcorns_min: RSTDDEV: cletiket=',cletiket
write(nulout,*) 'readcorns_min: RSTDDEV: ip1=',ip1
write(nulout,*) 'readcorns_min: RSTDDEV: ip2=',ip2
write(nulout,*) 'readcorns_min: RSTDDEV: ip3=',ip3
write(nulout,*) 'readcorns_min: RSTDDEV: cltypvar=',cltypvar
write(nulout,*) 'readcorns_min: RSTDDEV: clnomvar=',clnomvar
call abort3d(nulout
& ,'readcorns_min: Problem with background stat file')
endif
endif
if (ini .ne. nksdim2) then
write(nulout,*) 'readcorns_min: RSTDDEV: ini, nksdim2 =',ini,nksdim2
call abort3d(nulout
& ,'readcorns_min: BG stat levels inconsitencies')
endif
!
do jk = 1, nksdim2
rstddev(jk,jband-1) = zstdsrc(jk)
enddo
enddo
!
! CORNS
!
corns(:,:,:,:) = 0.0
!
do jband = 1, nband
idateo = -1
cletiket = 'CORNSMIN'
ip1 = -1
IP2 = jband-1
ip3 = -1
cltypvar = 'X'
clnomvar = 'ZN'
icornskey = vfstlir(zcornssrc,nulbgst,INI,INJ,INK
& ,idateo,cletiket,ip1,ip2,ip3,cltypvar,clnomvar)
!
if(icornskey .lt.0 ) then
call abort3d(nulout
& ,'readcorns_min: Problem with background stat file')
endif
!
if (ini .ne. nksdim2 .or. inj .ne. nksdim2) then
call abort3d(nulout
& ,'readcorns_min: BG stat levels inconsitencies')
endif
!
do j2=1,nksdim2
do j1=1,nksdim2
corns(j1,j2,jband-1,1) = zcornssrc(j1,j2)
enddo
enddo
!
IF(myid == 0) then
write(nulout,*) 'readcorns_min: Band nb. ',jband
call maxmin(zcornssrc,nksdim2,1,nksdim2,zmin,zmax,
& idum1,idum2,idum3,idum4,'readcorns_min ',
& 'CO')
endif
enddo ! jband loop
!
do jn = 0, ntrunc
write(nulout,*) 'readcorns_min: corns(322,322,jn,1) = ',jn,corns(322,322,jn,1)
enddo
!
if(myid==0.and.zmin.eq.0.0D0.and.zmax.eq.0.0D0) then
call abort3d(nulout
& ,'readcorns_min: CORNS is identically zero!')
endif
!
write(nulout,*) 'Done in readcorns_min'
!
return
end