!-------------------------------------- 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 --------------------------------------
!
!
! X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X
!
subroutine denorm 2,4
!
!**s/r denorm - Self-Adjoint denormalize analysis increments after undo preconditioning. Used for grd_typ = 'LU'.
!
!
!Author : Luc Fillion - CGD/NCAR - Jul 99
!Revision:
! Luc Fillion - ARMA/EC 20 May 2010 - Update on MPI version and improve documentation and conditional printing.
!
! -------------------
! Purpose: Used for XD-Var analysis
!
!Arguments
! none
!
implicit none
!
#include "taglam4d.cdk"
#include "comgrd_param.cdk"
#include "comdim.cdk"
#include "comct0.cdk"
#include "comgd0.cdk"
#include "comcva.cdk"
#include "comgrd.cdk"
#include "comrgsigla.cdk"
!
logical llprint
integer ji,jj,jk,idum1,idum2,idum3,idum4
INTEGER myid,numthd,omp_get_thread_num,omp_get_num_threads
real*8 zmin,zmax
real*8 zfld(ni,nflev,nj)
!
!!
llprint = .false.
!
if(llprint) then
do jj = 1,nj
do jk=1,nflev
do ji=1,ni
zfld(ji,jk,jj) = rgsiglapp(ji,jk,jj)
enddo
enddo
enddo
!
call maxmin
(zfld,ni,nj,nflev,zmin,zmax,
& idum1,idum2,idum3,idum4,'denorm ',
& 'PP ')
!
do jj = 1,nj
do jk=1,nflev
do ji=1,ni
zfld(ji,jk,jj) = rgsiglatu(ji,jk,jj)
enddo
enddo
enddo
!
call maxmin
(zfld,ni,nj,nflev,zmin,zmax,
& idum1,idum2,idum3,idum4,'denorm ',
& 'TU ')
!
do jj = 1,nj
do jk=1,nflev
do ji=1,ni
zfld(ji,jk,jj) = rgsiglalq(ji,jk,jj)
enddo
enddo
enddo
!
call maxmin
(zfld,ni,nj,nflev,zmin,zmax,
& idum1,idum2,idum3,idum4,'denorm ',
& 'LQ ')
!
do jj = 1,nj
do jk=1,1
do ji=1,ni
zfld(ji,jk,jj) = rgsiglapu(ji,jk,jj)
enddo
enddo
enddo
!
call maxmin
(zfld,ni,nj,1,zmin,zmax,
& idum1,idum2,idum3,idum4,'denorm ',
& 'P0 ')
endif
!
! Self-Adjoint de-normalize increments on grid
! --------------------------------------------
!
!$OMP PARALLEL PRIVATE(ji,jj,jk,myid,numthd)
myid=omp_get_thread_num()+1
numthd=omp_get_num_threads()
do jj = myid,nj,numthd
do jk=1,nflev
do ji=1,ni
ut0(ji,jk,jj) = rgsiglapp(ji,jk,jj)*ut0(ji,jk,jj)
vt0(ji,jk,jj) = rgsiglacu(ji,jk,jj)*vt0(ji,jk,jj)
tt0(ji,jk,jj) = rgsiglatu(ji,jk,jj)*tt0(ji,jk,jj)
q0(ji,jk,jj) = rgsiglalq(ji,jk,jj)*q0(ji,jk,jj)
enddo
enddo
!
do ji=1,ni
gps0(ji,1,jj) = rgsiglapu(ji,1,jj)*gps0(ji,1,jj)
enddo
enddo
!$OMP END PARALLEL
!
if(nanalvar.eq.4) then
do jj=1,nj
do ji=1,ni
do jk=1,nflev
tb0(ji,jk,jj) = rgsigla_tb(ji,jk,jj)*tb0(ji,jk,jj)
enddo
enddo
enddo
endif
!
return
end