!-------------------------------------- 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 CAININ(KDIM,PX) 3 #if defined (DOC) * ***s/r CAIN (Inverse canonical injection): transfer of COMSP into the * . control variable * * *Author : P. Gauthier *ARMA/AES January 27, 1993 * . (based on a subroutine by P.Courtier and M. Hamrud * . from the ARPEGE/IFS model) *Revision: * M. Buehner *ARMA May 2008 * . Added control variables when using background * error correlations specified over multiple latitude * bands (NANALVAR=4) * L. Fillion - Fev 2003 ARMA/MSC * . Lmited Area LAM4D analysis option. * L. Fillion - 6 Jan 2009 * . Upgrade to v_10_1_2 of 3dvar. * * ------------------- ** Purpose: identity transformation used to insure a communication * . link between the model state and the minimization algo- * . rithm. Also used to define the norm used (see also CAINAD) * *Arguments * i : KDIM = dimension of the control variable * i : PX = control variable #endif IMPLICIT NONE *implicits #include "comdim.cdk"
#include "comlun.cdk"
#include "comsp.cdk"
#include "comcva.cdk"
#include "comgrd_param.cdk"
* INTEGER KDIM, JDIM, JLEV, JLA, JLATBIN REAL*8 PX(KDIM) EXTERNAL ABORT3D C C 1. Transfer of the spectral model state C 100 CONTINUE C JDIM = 0 C if(grd_typ.eq.'GU') then if(nanalvar.eq.4) then DO JLATBIN=1,NLATBIN DO JLEV = 1, NKSDIM DO JLA = 1, NTRUNC + 1 JDIM = JDIM + 1 PX(JDIM) = SPLAT(JLA,1,JLEV,JLATBIN) ENDDO DO JLA = NTRUNC+2, NLA JDIM = JDIM + 1 PX(JDIM) = SPLAT(JLA,1,JLEV,JLATBIN) JDIM = JDIM + 1 PX(JDIM) = SPLAT(JLA,2,JLEV,JLATBIN) ENDDO ENDDO ENDDO else DO 101 JLEV = 1, NKSDIM DO 102 JLA = 1, NTRUNC + 1 JDIM = JDIM + 1 PX(JDIM) = SP(JLA,1,JLEV) 102 CONTINUE DO 103 JLA = NTRUNC+2, NLA JDIM = JDIM + 1 PX(JDIM) = SP(JLA,1,JLEV) JDIM = JDIM + 1 PX(JDIM) = SP(JLA,2,JLEV) 103 CONTINUE 101 CONTINUE endif else if (grd_typ.eq.'LU') then if(nanalvar.eq.4) then do jlev = 1, nksdim do jla = 1,nla jdim = jdim + 1 px(jdim) = splat(jla,1,jlev,1) jdim = jdim + 1 px(jdim) = splat(jla,2,jlev,1) enddo enddo else do jlev = 1, nksdim do jla = 1,nla jdim = jdim + 1 px(jdim) = sp(jla,1,jlev) jdim = jdim + 1 px(jdim) = sp(jla,2,jlev) enddo enddo endif endif C C 2. Verify the dimension of the control variable C 200 CONTINUE IF(JDIM.NE.KDIM) THEN WRITE(NULOUT,FMT=9200)KDIM, JDIM c CALL ABORT3D(NULOUT,'ERROR IN CAININ ') END IF 9200 FORMAT(//,10X,'Error in CAININ. Wrong dimension', S ' for the control variable. KDIM = ',I8,4X,'JDIM =',I8) C RETURN END