!-------------------------------------- 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 meangd_gu(kulstat,kulstdev) 1,37
#if defined (DOC)
*
***s/r meangd_gu: calculate mean and variances for stats runs
*
*Author: L. Fillion *ARMA/EC 16 May 2008 (from meangd.ftn)
* Make it operate as in lam4d mode.
*Revision:
* L. Fillion *ARMA/EC 5 Jun 2008 - Compute gridpoint vort,div and store on file for the last sample treated.
! Store also last sample of gridpoint psi/chi.
! - Change ackward spectral loop index jlat --> jla in PSI/CHI computation.
*
*Arguments KULSTAT logical unit number
*
#endif
IMPLICIT NONE
*implicits
#include "pardim.cdk"
#include "comdim.cdk"
#include "comlun.cdk"
#include "comct0.cdk"
#include "comcst.cdk"
#include "comgem.cdk"
#include "comsp.cdk"
#include "comgd0.cdk"
#include "comgdpar.cdk"
#include "comcse1.cdk"
#include "comstdd.cdk"
*
INTEGER KULSTAT,kulstdev
C
INTEGER JENS, IENS, JK1, IERR, JFILE, ji,jj,JK, jla,JLAT, JLON
C
logical loutqd,llfilt
INTEGER FNOM, FSTOUV, FSTFRM, FCLOS, FSTPRM, FSTINL
INTEGER VFSTECR
C
C* RPN Standard files parameters
C
INTEGER INI,INJ,INK, INPAS, INBITS, IDATYP, IDEET
+ ,IP1,IP2,IP3,IG1,IG2,IG3,IG4,ISWA,ILENGTH,IDLTF
+ ,IUBC,IEXTR1,IEXTR2,IEXTR3
INTEGER ILISTE(100),IDATE(100), IDATV(100), IDIMAX, INFON, IFSTRUN, IHH
integer jlev, itrlgid,ind
integer iip1s(jpnflev),iip1,iip2,iip3,itrlnlev
integer ipmode,ipkind,ip1_pak_trl,ip1_vco_trl
integer :: k,koutmpg ! the unit which has the selected records.
real zlev(jpnflev)
character*1 clstring
REAL*8 DHEURES
CHARACTER*1 CLTYPVAR,CLGRTYP
CHARACTER*2 CLNOMVAR
CHARACTER*8 CLETIKET
C
REAL*8 DLA2
REAL*8 ZFACT
INTEGER IPAK, IDATEO, IKULFILE
CHARACTER*128 CLFLFILE
CHARACTER*1 clflt
real*8 zonaluu(nj,nflev)
real*8 zonalvv(nj,nflev)
real*8 zonaltt(nj,nflev)
real*8 zonalpp(nj,nflev)
real*8 zonalcc(nj,nflev)
real*8 zonallq(nj,nflev)
!
real*8 zsavvort(ni,nj,nflev)
real*8 zsavdiv(ni,nj,nflev)
real*8 zsavpsi(ni,nj,nflev)
real*8 zfltpsi(ni,nj,nflev)
real*8 zsavchi(ni,nj,nflev)
real*8 zsavtt(ni,nj,nflev)
!
real*8 zmeanuu(ni,nj,nflev)
real*8 zmeanvv(ni,nj,nflev)
real*8 zmeantt(ni,nj,nflev)
real*8 zmeanlq(ni,nj,nflev)
real*8 zmeanpp(ni,nj,nflev)
real*8 zmeancc(ni,nj,nflev)
real*8 zmeanes(ni,nj,nflev)
real*8 zmeanhu(ni,nj,nflev)
real*8 zmeangz(ni,nj,nflev)
!
real*8 zmeanp0(ni,nj)
!
real*8 zstduu(ni,nj,nflev)
real*8 zstdvv(ni,nj,nflev)
real*8 zstdtt(ni,nj,nflev)
real*8 zstdlq(ni,nj,nflev)
real*8 zstdpp(ni,nj,nflev)
real*8 zstdcc(ni,nj,nflev)
real*8 zstdp0(ni,nj)
!
real*8 zgd(nibeg:niend,nflev,njbeg:njend)
real*8 zsp(nla,2,nflev)
real*8 zspnks(nla,2,nksdim)
!
!!
loutqd = .false.
llfilt = .false.
if(lflt_low) then
llfilt = .true.
clflt = 'L'
else if(lflt_high) then
llfilt = .true.
clflt = 'H'
endif
!
DLA2 = DBLE(RA) * DBLE(RA)
IKULFILE = kulstdev
C
C INITIALIZE ACCUMULATORS
C
DO JLAT = NJBEG, NJEND
DO JK1 = 1, NKGDIM+2*NFLEV
DO JLON = NIBEG, NIEND
XMGD(JLON,JK1,JLAT) = 0.0
SGD(JLON,JK1,JLAT) = 0.0
ENDDO
ENDDO
ENDDO
C
100 CONTINUE
!
C* 2. Access the increments of from a set of files
C . (loop on the files)
C
200 CONTINUE
IDIMAX = 100
DO 201 JFILE = 1, NFLSTAT
C
CALL GETINCR(KULSTAT,JFILE)
C
C* . 2.1 Find how many cases there are to be treated
C
210 CONTINUE
C
IP1 = -1
IP2 = -1
IP3 = -1
CLNOMVAR = 'P0'
IP1 =0
c
write(NULOUT,*)
IERR = FSTINL (KULSTAT,INI,INJ,INK
S ,-1,CETIKETN,IP1,IP2,IP3,' '
S ,CLNOMVAR,ILISTE,INFON,IDIMAX)
WRITE(NULOUT,9210)INFON
9210 FORMAT(//,4X,"Ensemble of ",I4," increments")
IF(INFON.EQ.0) THEN
WRITE(NULOUT,*)' THIS FILE IS EMPTY. CHECK THE SELECTION CRITERIA'
CALL ABORT3D(NULOUT,'meangd_gu: problem with FSTINL')
END IF
IENS = INFON
C
C* . 2.2 Get all the dates at which increments are available
C
220 CONTINUE
DO JENS = 1, IENS
IERR = FSTPRM(ILISTE(JENS),IDATE(JENS),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
DHEURES = DBLE(INPAS*IDEET/3600)
cjmb
CALL INCDATR(IDATV(JENS),IDATE(JENS),SNGL(DHEURES))
CALL NEWDATE(IDATV(JENS),IFSTRUN,IHH,-3)
WRITE(NULOUT,9320)JENS, IFSTRUN,IHH
END DO
9320 FORMAT(5X,"Case No. ",I3,5x,"Date and time: ",I10,5x,I8)
C
IF(NENSEMBLE.EQ.0) THEN
NDATESTAT = IDATE(1)
END IF
C
CTYPVARN = ' '
CETIKETN = CLETIKET
!
! 2.3 Loop on the ensemble contained in the current file of differences
!
DO 231 JENS = 1, IENS
!
! Get the increment in grid-point form
!
CALL NEWDATE(IDATV(JENS),IFSTRUN,IHH,-3)
WRITE(NULOUT,9310)JENS, IFSTRUN,IHH
9310 FORMAT(///,5X,"--- Case No. ",I3,5x,"Date and time: ",I10,5x
& ,I8)
NSTAMPN = IDATE(JENS)
CALL GETFST(KULSTAT,'G','N',IP3)
C
C ACCUMULATE SUM OF ELEMENTS AND SUM OF SQUARED ELEMENTS
C
DO JLAT = NJBEG, NJEND
DO JK1 = 1, NKGDIM
DO JLON = NIBEG, NIEND
XMGD(JLON,JK1,JLAT) = XMGD(JLON,JK1,JLAT) +
+ GD(JLON,JK1,JLAT)
SGD(JLON,JK1,JLAT) = SGD(JLON,JK1,JLAT) +
+ GD(JLON,JK1,JLAT) * GD(JLON,JK1,JLAT)
ENDDO
ENDDO
ENDDO
C
C COMPUTE Gridpoint VORT AND DIV for output on file
C
if(loutqd) then
call transfer('GD01') ! save gridpoint state in GD1 and reset after
CALL GDSP
CALL SPEREE(NKSDIM,SP,GD,NLA,NIBEG,NIEND,NJBEG,NJEND,NKSDIM)
do jk = 1, nflev
do jj = 1, nj
ind = nj-jj+1
do ji = 1, ni
zsavvort(ji,ind,jk) = ut0(ji,jk,jj)
zsavdiv(ji,ind,jk) = vt0(ji,jk,jj)
enddo
enddo
enddo
call transfer('GD10') ! reset GD0 to its original state
endif
C
C COMPUTE PSI AND CHI
C
CALL GDSP
C
C CONVERT FROM VORT/DIV TO PSI/CHI
C
DO JK = 1, NFLEV
DO jla = 1, NLA
SPVOR(jla,1,JK) = SPVOR(jla,1,JK) * DLA2*R1SNP1(jla)
SPVOR(jla,2,JK) = SPVOR(jla,2,JK) * DLA2*R1SNP1(jla)
SPDIV(jla,1,JK) = SPDIV(jla,1,JK) * DLA2*R1SNP1(jla)
SPDIV(jla,2,JK) = SPDIV(jla,2,JK) * DLA2*R1SNP1(jla)
ENDDO
ENDDO
!
if(llfilt) then
do jk=1,nksdim
do jla = 1,nla
zspnks(jla,1,jk) = sp(jla,1,jk)
zspnks(jla,2,jk) = sp(jla,2,jk)
enddo
enddo
call sptruncr_glb(zspnks,'T',mflt_trunc,clflt,nksdim)
do jk=1,nflev
do jla = 1,nla
sp(jla,1,jk) = zspnks(jla,1,jk)
sp(jla,2,jk) = zspnks(jla,2,jk)
enddo
enddo
!
! call speree(nflev,zsp,zgd,nla,nibeg,niend,njbeg,njend,nflev)
! do jk = 1, nflev
! do jj = 1, nj
! ind = nj-jj+1
! do ji = 1, ni
! zfltpsi(ji,ind,jk) = zgd(ji,jk,jj)
! enddo
! enddo
! enddo
endif
!
CALL SPEREE(NKSDIM,SP,GD,NLA,NIBEG,NIEND,NJBEG,NJEND,NKSDIM)
!
do jk = 1, nflev
do jj = 1, nj
ind = nj-jj+1
do ji = 1, ni
zsavpsi(ji,ind,jk) = ut0(ji,jk,jj)
zsavchi(ji,ind,jk) = vt0(ji,jk,jj)
enddo
enddo
enddo
C
C ACCUMULATE SUMS AND SUMS OF SQUARED VALUES
C
DO JLAT = NJBEG, NJEND
DO JK1 = 1, NFLEV
DO JLON = NIBEG, NIEND
XMPP(JLON,JK1,JLAT) = XMPP(JLON,JK1,JLAT) +
+ UT0(JLON,JK1,JLAT)
XMCC(JLON,JK1,JLAT) = XMCC(JLON,JK1,JLAT) +
+ VT0(JLON,JK1,JLAT)
SPP(JLON,JK1,JLAT) = SPP(JLON,JK1,JLAT) +
+ UT0(JLON,JK1,JLAT)*UT0(JLON,JK1,JLAT)
SCC(JLON,JK1,JLAT) = SCC(JLON,JK1,JLAT) +
+ VT0(JLON,JK1,JLAT)*VT0(JLON,JK1,JLAT)
ENDDO
ENDDO
ENDDO
231 CONTINUE ! end loop on the ensemble within current file
!
NENSEMBLE = NENSEMBLE + IENS
C
IERR = FSTFRM (KULSTAT)
IERR = FCLOS (KULSTAT)
C
201 CONTINUE ! end loop on jfile
C
C*3. COMPUTE VARIANCES OF GD FOR THE ENSEMBLE
C
DO JLAT = NJBEG, NJEND
DO JK1 = 1, NKGDIM+2*NFLEV
DO JLON = NIBEG, NIEND
SGD(JLON,JK1,JLAT) = ( SGD(JLON,JK1,JLAT) -
+ ((XMGD(JLON,JK1,JLAT)*XMGD(JLON,JK1,JLAT)) / NENSEMBLE )) /
+ (NENSEMBLE - 1)
ENDDO
ENDDO
ENDDO
C
C*4. COMPUTE THE MEAN OF GD FOR THE ENSEMBLE
C
DO JLAT = NJBEG, NJEND
DO JK1 = 1, NKGDIM+2*NFLEV
DO JLON = NIBEG, NIEND
XMGD(JLON,JK1,JLAT) = XMGD(JLON,JK1,JLAT) / NENSEMBLE
ENDDO
ENDDO
ENDDO
C
C ACCUMULATE ZONAL VALUES OF VARIANCES IN FIRST LON
C
zonaluu(:,:) = 0.0
zonalvv(:,:) = 0.0
zonaltt(:,:) = 0.0
zonalpp(:,:) = 0.0
zonalcc(:,:) = 0.0
!
DO JLAT = 1, NJ
DO JK1 = 1, NFLEV
DO JLON = 2, NI
zonaluu(jlat,JK1) = zonaluu(jlat,JK1) + suu(JLON,JK1,JLAT)
zonalvv(jlat,JK1) = zonalvv(jlat,JK1) + svv(JLON,JK1,JLAT)
zonaltt(jlat,JK1) = zonaltt(jlat,JK1) + stt(JLON,JK1,JLAT)
zonalpp(jlat,JK1) = zonalpp(jlat,JK1) + spp(JLON,JK1,JLAT)
zonalcc(jlat,JK1) = zonalcc(jlat,JK1) + scc(JLON,JK1,JLAT)
!cluc SGD(1,JK1,JLAT) = SGD(1,JK1,JLAT) + SGD(JLON,JK1,JLAT)
ENDDO
ENDDO
ENDDO
C
C ZONAL AVERAGE STD DEV = SQRT OF ZONAL AVERAGE OF VARIANCES
C
DO JLAT = 1, NJ
ZFACT = 1. / (CONIMA(JLAT) * RMSKNT)
DO JK1=1,NFLEV
STDUU(NJ-JLAT+1,JK1) = SQRT(zonaluu(jlat,JK1)/NILON(JLAT)) * ZFACT
STDVV(NJ-JLAT+1,JK1) = SQRT(zonalvv(jlat,JK1)/NILON(JLAT)) * ZFACT
STDTT(NJ-JLAT+1,JK1) = SQRT(zonaltt(jlat,JK1)/NILON(JLAT)) * ZFACT
STDLQ(NJ-JLAT+1,JK1) = SQRT(zonallq(jlat,JK1)/NILON(JLAT)) * ZFACT
!cluc STDVV(NJ-JLAT+1,JK1) = SQRT(SVV(1,JK1,JLAT)/NILON(JLAT)) * ZFACT
!cluc STDTT(NJ-JLAT+1,JK1) = SQRT(STT(1,JK1,JLAT)/NILON(JLAT))
!cluc STDLQ(NJ-JLAT+1,JK1) = SQRT(SLQ(1,JK1,JLAT)/NILON(JLAT))
c ATTN: Dans les hauts niveaux du modele il est possible
c que les champs de difference de LQ soient 0.0 a
c a chacun des points de grille.
c On remplace 0.0 par une petite valeur pour eviter
c de normaliser par une valeur zero dans cse2.ftn par exemple
if(STDLQ(NJ-JLAT+1,JK1) .eq. 0.0) then
STDLQ(NJ-JLAT+1,JK1) = 1.0E-10
endif
STDPP(NJ-JLAT+1,JK1) = SQRT(zonalpp(jlat,JK1)/NILON(JLAT))
STDCC(NJ-JLAT+1,JK1) = SQRT(zonalcc(jlat,JK1)/NILON(JLAT))
ENDDO
STDP0(NJ-JLAT+1) = SQRT(SP0(1,1,JLAT)/NILON(JLAT)) * 0.01
ENDDO
C
C 3D Mean & St-dev
C
do jk=1,nflev
do jj=1,nj
ind = nj-jj+1
zfact = 1./(conima(jj)*rmsknt)
do ji=1,ni
zmeanuu(ji,jj,jk) = xmuu(ji,jk,jj) * zfact
zmeanvv(ji,jj,jk) = xmvv(ji,jk,jj) * zfact
zmeantt(ji,jj,jk) = xmtt(ji,jk,jj)
zmeanlq(ji,jj,jk) = xmlq(ji,jk,jj)
zmeanpp(ji,jj,jk) = xmpp(ji,jk,jj)
zmeancc(ji,jj,jk) = xmcc(ji,jk,jj)
! zmeanes(ji,jj,jk) = xmes(ji,jk,jj)
! zmeangz(ji,jj,jk) = xmgz(ji,jk,jj)
! zmeanhu(ji,jj,jk) = xmhu(ji,jk,jj)
!
zstduu(ji,ind,jk) = sqrt(suu(ji,jk,jj)) * zfact
zstdvv(ji,ind,jk) = sqrt(svv(ji,jk,jj)) * zfact
zstdtt(ji,ind,jk) = sqrt(stt(ji,jk,jj))
zstdlq(ji,ind,jk) = sqrt(slq(ji,jk,jj))
zstdpp(ji,ind,jk) = sqrt(spp(ji,jk,jj))
zstdcc(ji,ind,jk) = sqrt(scc(ji,jk,jj))
enddo
enddo
enddo
!
! 2D Mean & St-dev
!
do jj=1,nj
ind = nj-jj+1
do ji=1,ni
zmeanp0(ji,jj) = xmp0(ji,1,jj) * 0.01
zstdp0(ji,ind) = sqrt(sp0(ji,1,jj)) * 0.01
enddo
enddo
C
C*5 Output MEAN & STD-DEV in RPN standard field units
C
IPAK = -32
IDATYP = 5
IP1 = 0
IP2 = 0
IP3 = NENSEMBLE
IDATEO = NDATESTAT
!
IF (NCONF .EQ. 500) THEN
CLFLFILE = CFLPTOT
ELSE
CLFLFILE = CFLSTDEV
ENDIF
!
! IERR = FNOM(IKULFILE,CLFLFILE,'RND',0)
! IERR = FSTOUV(IKULFILE,'RND')
!
! Zonal-stdev are in STDUU, STDVV, etc...
!
IERR = VFSTECR(STDUU,STDUU,IPAK,IKULFILE,IDATEO,0,0,1,NJ,
+ NFLEV,IP1,IP2,IP3,'E',CFSTVAR(1),'ZONALSTD',
+ 'X',0,0,0,0,IDATYP,.TRUE.)
!
IERR = VFSTECR(STDVV,STDVV,IPAK,IKULFILE,IDATEO,0,0,1,NJ,
+ NFLEV,IP1,IP2,IP3,'E',CFSTVAR(2),'ZONALSTD',
+ 'X',0,0,0,0,IDATYP,.TRUE.)
!
IERR = VFSTECR(STDTT,STDTT,IPAK,IKULFILE,IDATEO,0,0,1,NJ,
+ NFLEV,IP1,IP2,IP3,'E',CFSTVAR(3),'ZONALSTD',
+ 'X',0,0,0,0,IDATYP,.TRUE.)
!
IERR = VFSTECR(STDLQ,STDLQ,IPAK,IKULFILE,IDATEO,0,0,1,NJ,
+ NFLEV,IP1,IP2,IP3,'E',CFSTVAR(4),'ZONALSTD',
+ 'X',0,0,0,0,IDATYP,.TRUE.)
!
IERR = VFSTECR(STDPP,STDPP,IPAK,IKULFILE,IDATEO,0,0,1,NJ,
+ NFLEV,IP1,IP2,IP3,'E','PP','ZONALSTD',
+ 'X',0,0,0,0,IDATYP,.TRUE.)
!
IERR = VFSTECR(STDCC,STDCC,IPAK,IKULFILE,IDATEO,0,0,1,NJ,
+ NFLEV,IP1,IP2,IP3,'E','CC','ZONALSTD',
+ 'X',0,0,0,0,IDATYP,.TRUE.)
!
IERR = VFSTECR(STDP0,STDP0,IPAK,IKULFILE,IDATEO,0,0,1,NJ,
+ 1 ,IP1,IP2,IP3,'E',CFSTVAR2D(1),'ZONALSTD',
+ 'X',0,0,0,0,IDATYP,.TRUE.)
!
! 3D-stdev are in zstduu,zstdvv etc...
!
do jk=1,nflev
IP1 = NIP1(jk)
! UU
IERR = VFSTECR(zmeanuu(1,1,jk),zmeanuu(1,1,jk),IPAK,IKULFILE,IDATEO,
& 0,0,ni,nj,1,IP1,IP2,IP3,'E','UU','MEANGD ',
& 'G',0,0,0,0,IDATYP,.TRUE.)
IERR = VFSTECR(zstduu(1,1,jk),zstduu(1,1,jk),IPAK,IKULFILE,IDATEO,
& 0,0,ni,nj,1,IP1,IP2,IP3,'E','UU','STDEV-2D',
& 'G',0,0,0,0,IDATYP,.TRUE.)
! VV
IERR = VFSTECR(zmeanvv(1,1,jk),zmeanvv(1,1,jk),IPAK,IKULFILE,IDATEO,
& 0,0,ni,nj,1,IP1,IP2,IP3,'E','VV','MEANGD ',
& 'G',0,0,0,0,IDATYP,.TRUE.)
IERR = VFSTECR(zstdvv(1,1,jk),zstdvv(1,1,jk),IPAK,IKULFILE,IDATEO,
& 0,0,ni,nj,1,IP1,IP2,IP3,'E','VV','STDEV-2D',
& 'G',0,0,0,0,IDATYP,.TRUE.)
! TT
IERR = VFSTECR(zmeantt(1,1,jk),zmeantt(1,1,jk),IPAK,IKULFILE,IDATEO,
& 0,0,ni,nj,1,IP1,IP2,IP3,'E','TT','MEANGD ',
& 'G',0,0,0,0,IDATYP,.TRUE.)
IERR = VFSTECR(zstdtt(1,1,jk),zstdtt(1,1,jk),IPAK,IKULFILE,IDATEO,
& 0,0,ni,nj,1,IP1,IP2,IP3,'E','TT','STDEV-2D',
& 'G',0,0,0,0,IDATYP,.TRUE.)
! LQ
IERR = VFSTECR(zmeanlq(1,1,jk),zmeanlq(1,1,jk),IPAK,IKULFILE,IDATEO,
& 0,0,ni,nj,1,IP1,IP2,IP3,'E','LQ','MEANGD ',
& 'G',0,0,0,0,IDATYP,.TRUE.)
IERR = VFSTECR(zstdlq(1,1,jk),zstdlq(1,1,jk),IPAK,IKULFILE,IDATEO,
& 0,0,ni,nj,1,IP1,IP2,IP3,'E','LQ','STDEV-2D',
& 'G',0,0,0,0,IDATYP,.TRUE.)
! PP
IERR = VFSTECR(zmeanpp(1,1,jk),zmeanpp(1,1,jk),IPAK,IKULFILE,IDATEO,
& 0,0,ni,nj,1,IP1,IP2,IP3,'E','PP','MEANGD ',
& 'G',0,0,0,0,IDATYP,.TRUE.)
IERR = VFSTECR(zstdpp(1,1,jk),zstdpp(1,1,jk),IPAK,IKULFILE,IDATEO,
& 0,0,ni,nj,1,IP1,IP2,IP3,'E','PP','STDEV-2D',
& 'G',0,0,0,0,IDATYP,.TRUE.)
! PP
IERR = VFSTECR(zmeancc(1,1,jk),zmeancc(1,1,jk),IPAK,IKULFILE,IDATEO,
& 0,0,ni,nj,1,IP1,IP2,IP3,'E','CC','MEANGD ',
& 'G',0,0,0,0,IDATYP,.TRUE.)
IERR = VFSTECR(zstdcc(1,1,jk),zstdcc(1,1,jk),IPAK,IKULFILE,IDATEO,
& 0,0,ni,nj,1,IP1,IP2,IP3,'E','CC','STDEV-2D',
& 'G',0,0,0,0,IDATYP,.TRUE.)
if(loutqd) then
IERR = VFSTECR(zsavvort(1,1,jk),zsavvort(1,1,jk),IPAK,IKULFILE,IDATEO,
& 0,0,ni,nj,1,IP1,IP2,IP3,'E','QQ','ERR-GU ',
& 'G',0,0,0,0,IDATYP,.TRUE.)
IERR = VFSTECR(zsavdiv(1,1,jk),zsavdiv(1,1,jk),IPAK,IKULFILE,IDATEO,
& 0,0,ni,nj,1,IP1,IP2,IP3,'E','DD','ERR-GU ',
& 'G',0,0,0,0,IDATYP,.TRUE.)
endif
IERR = VFSTECR(zsavpsi(1,1,jk),zsavpsi(1,1,jk),IPAK,IKULFILE,IDATEO,
& 0,0,ni,nj,1,ip1,ip2,ip3,'E','PP','ERR-GU ',
& 'G',0,0,0,0,IDATYP,.TRUE.)
IERR = VFSTECR(zfltpsi(1,1,jk),zfltpsi(1,1,jk),IPAK,IKULFILE,IDATEO,
& 0,0,ni,nj,1,ip1,ip2,ip3,'E','PP','ERRGUFLT',
& 'G',0,0,0,0,IDATYP,.TRUE.)
IERR = VFSTECR(zsavchi(1,1,jk),zsavchi(1,1,jk),IPAK,IKULFILE,IDATEO,
& 0,0,ni,nj,1,IP1,IP2,IP3,'E','CC','ERR-GU ',
& 'G',0,0,0,0,IDATYP,.TRUE.)
IERR = VFSTECR(zsavtt(1,1,jk),zsavtt(1,1,jk),IPAK,IKULFILE,IDATEO,
& 0,0,ni,nj,1,IP1,IP2,IP3,'E','TT','ERR-GU ',
& 'G',0,0,0,0,IDATYP,.TRUE.)
enddo
!
! 2D
!
IERR = VFSTECR(zmeanp0(1,1),zmeanp0(1,1),IPAK,IKULFILE,IDATEO,
& 0,0,ni,nj,1,IP1,IP2,IP3,'E','P0','MEANGD ',
& 'G',0,0,0,0,IDATYP,.TRUE.)
IERR = VFSTECR(zstdp0(1,1),zstdp0(1,1),IPAK,IKULFILE,IDATEO,
& 0,0,ni,nj,1,IP1,IP2,IP3,'E','P0','STDEV-2D',
& 'G',0,0,0,0,IDATYP,.TRUE.)
!
! IERR = FSTFRM(IKULFILE)
! IERR = FCLOS(IKULFILE)
!
NENSEMBLE=0
write(nulout,*) 'meangd_gu: END'
!
RETURN
END