!-------------------------------------- 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(KULCORNS,CDFLCORNS 3,2
S ,KULSTDEV,CDFLSTDEV,KDATESTAMP, KENSEMBLE)
#if defined (DOC)
*
***s/r READCORNS - Read CORNS and RSTDDEV from RPN standard files
*
*
*Author : P. Gauthier *ARMA/AES December, 1996
*Revision:
* . J. Halle *CMDA/AES Oct 99.
* - Read correlations in local buffer before storing in common arrays.
* C. Charette *ARMA/AES Jan 2000
* - Remove fnom. Assume stats file is already open
*
* JM Belanger CMDA/SMC Jul 2000
* . 32 bits conversion
*
* -------------------
** Purpose:
*Arguments
* KULCORNS : logical unit assigned to the CORNS file
* CDFLCORNS : filename for CORNS
* KULSTDEV : logical unit assigned to the RSTDDEV file
* CDFLSTDEV : filename for RSTDDEV
* KDATESTAMP: date of validity
* KENSEMBLE : number of members in the ensemble used to
* . estimate these correlations
#endif
IMPLICIT NONE
*implicits
*
* Global variables
*
#include "comdim.cdk"
#include "comlun.cdk"
#include "comcorr.cdk"
*
* Arguments
*
CHARACTER*128 CDFLCORNS, CDFLSTDEV
INTEGER KULCORNS, KULSTDEV, KDATESTAMP, KENSEMBLE
*
* Local variables
*
INTEGER JN, JK1, IKEY, JI, JJ, INDX, ILEN
C
REAL*8 ZBUFFER(NKSDIM*NKSDIM)
*
POINTER (PXZBUFFER,ZBUFFER)
integer vfstlir
external vfstlir
#include "rpnstd.cdk"
*
**
* 0. Allocating local array
C -------------------------
*
ILEN = NKSDIM*NKSDIM
CALL HPALLOC(PXZBUFFER,MAX(1,ILEN),IERR,8)
C
C 1. Read CORNS(NKSDIM,NKSDIM,0:NTRUNC,1), the current estimate
C . of the normalized spectral correlations and
C
410 CONTINUE
C
WRITE(NULOUT,*)'READCORNS: spectral correlations from file: '
& , CDFLCORNS
C
IP1 = -1
IP3 = -1
IDATEO = -1
C
DO JN = 0, NTRUNC
IP2 = JN
IKEY = VFSTLIR
(ZBUFFER,KULCORNS,INI,INJ,INK
S ,IDATEO,'CORRNS ',IP1,IP2,IP3,' ',' ')
INDX = 0
DO JJ = 1, INJ
DO JI = 1, INI
INDX = INDX + 1
CORNS(JI,JJ,JN,1) = ZBUFFER(INDX)
ENDDO
ENDDO
END DO
c do jn=0,ntrunc
c do jk1=1,nksdim
c write(nulout,*) 'CORNS DIAG:',jn,jk1,corns(jk1,jk1,jn,1)
c enddo
c enddo
C
C 2. Read RSTDDEV(NKSDIM,0:NTRUNC), the non-normalized
C . spectral variances
C
C * 2.1 Opening the file containing the spectral variances
C
320 CONTINUE
C
C
write(nulout,*)'READCORNS: spectral variances from file: '
& , CDFLSTDEV
*
*
* . 2.2 Read the spectral standard deviations
*
IP1=-1
IP3=-1
DO JN = 0, NTRUNC
IP2 = JN
IERR = VFSTLIR
(RSTDDEV(1,JN),KULSTDEV,INI,INJ,INK
S ,IDATEO,'RSTDDEV ',IP1,IP2,IP3,' ',' ')
END DO
c
IERR = FSTPRM(IKEY,IDATEO,IDEET,INPAS
+ ,INI,INJ,INK, INBITS, IDATYP
+ ,IP1,IP2,IP3,CLTYPVAR,CLNOMVAR,CLETIKET,CLGRTYP
+ ,IG1,IG2,IG3,IG4,ISWA,ILENGTH,IDLTF
+ ,IUBC,IEXTR1,IEXTR2,IEXTR3)
C
KENSEMBLE = IP3
KDATESTAMP = IDATEO
C
c IF(IDATEO.NE.KDATESTAMP.OR.IP3.NE.KENSEMBLE) THEN
c WRITE(NULOUT,9421)IP3,KENSEMBLE,IDATEO,KDATESTAMP
c CALL ABORT3D(NULOUT,'SU1CSE1')
c END IF
c 9421 FORMAT(/,10X,"Inconsistency in the statistics files",/
c S ,15X,"NENSEMBLE = ",I3," for RSTDDEV",/
c S ,25X,"= ",I3,"for CORRNS"
c S ,15X,"KDATESTAMP = ",I3," for RSTDDEV",/
c S ,25X,"= ",I3,"for CORRNS")
*
*
* 3. Deallocate local array
*
CALL HPDEALLC(PXZBUFFER,IERR,1)
C
RETURN
END