!--------------------------------------- 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 --------------------------------------
module burpFiles_mod 4,1
use mpivar_mod
implicit none
save
private
! public variables
public :: burp_nfiles,burp_cfamtyp,burp_cfilnam
! public procedures
public :: burp_setupfiles
integer, parameter :: jpfiles=64
integer :: burp_nfiles
character(len=2) :: burp_cfamtyp(jpfiles)
character(len=128) :: burp_cfilnam(jpfiles)
contains
SUBROUTINE burp_setupfiles(datestamp) 1
implicit none
!s/r setup_burpfiles -INITIALZE BURP FILE NAMES and return datestamp
!
!
INTEGER IER,INBLKS,nulburp,JJ
INTEGER FNOM,FCLOS,NUMBLKS
CHARACTER(len=20) :: CLVALU(JPFILES)
CHARACTER(len=2) :: CFAMI(JPFILES)
CHARACTER(len=4) :: cmyidx, cmyidy
CHARACTER(len=9) :: cmyid
CHARACTER(len=128) :: burpin
LOGICAL isExist_L
INTEGER KTIME,KDATE
INTEGER IHANDL,ILONG,DATESTAMP
INTEGER ITIME,IFLGS,IDBURP,ILAT,ILON,IDX,IDY
INTEGER IALT,IDELAY,IDATE,IRS,IRUNN,INBLK,ISUP,IXAUX
INTEGER INSUP,INXAUX
INTEGER, ALLOCATABLE :: IBUF(:)
INTEGER INRECS
INTEGER MRFCLS,MRFOPN,MRFOPC,MRBHDR,MRFLOC,MRFGET
INTEGER MRFMXL
INTEGER NBRPDATE,NBRPHH,ISTAMPOBS,INEWHH,NEWDATE
REAL*8 DELHH
INTEGER IVALS
CHARACTER*9 CLSTNID
EXTERNAL FCLOS,FNOM,MRFCLS,MRFOPN,MRFOPC,MRBHDR,MRFLOC,MRFGET,MRFMXL,NUMBLKS
write(cmyidy,'(I4.4)') (mpi_npey-mpi_myidy)
write(cmyidx,'(I4.4)') (mpi_myidx+1)
cmyid = trim(cmyidx)//'_'//trim(cmyidy)
CLVALU( 1) = 'brpuan'
CLVALU( 2) = 'brpuas'
CLVALU( 3) = 'brpai'
CLVALU( 4) = 'brpain'
CLVALU( 5) = 'brpais'
CLVALU( 6) = 'brpaie'
CLVALU( 7) = 'brpaiw'
CLVALU( 8) = 'brpsfc'
CLVALU( 9) = 'brpsf'
CLVALU(10) = 'brptov'
CLVALU(11) = 'brpssmis'
CLVALU(12) = 'brpairs'
CLVALU(13) = 'brpto_amsua'
CLVALU(14) = 'brpto_amsub'
CLVALU(15) = 'brpcsr'
CLVALU(16) = 'brpiasi'
CLVALU(17) = 'brpsw'
CLVALU(18) = 'brpswgoes9'
CLVALU(19) = 'brpswgoese'
CLVALU(20) = 'brpswgoesw'
CLVALU(21) = 'brpswmodis'
CLVALU(22) = 'brpswmtsate'
CLVALU(23) = 'brpswmtsatw'
CLVALU(24) = 'brpgo'
CLVALU(25) = 'brpsc'
CLVALU(26) = 'brppr'
CLVALU(27) = 'brpro'
CLVALU(28) = 'brphum'
CLVALU(29) = 'brpsat'
CLVALU(30) = 'brpssm'
CLVALU(31) = 'brpo3'
CLVALU(32) = 'brpoz'
CLVALU(33) = 'brpgp'
CLVALU(34) = ' '
CFAMI( 1) = 'UA'
CFAMI( 2) = 'UA'
CFAMI( 3) = 'AI'
CFAMI( 4) = 'AI'
CFAMI( 5) = 'AI'
CFAMI( 6) = 'AI'
CFAMI( 7) = 'AI'
CFAMI( 8) = 'SF'
CFAMI( 9) = 'SF'
CFAMI(10) = 'TO'
CFAMI(11) = 'TO'
CFAMI(12) = 'TO'
CFAMI(13) = 'TO'
CFAMI(14) = 'TO'
CFAMI(15) = 'TO'
CFAMI(16) = 'TO'
CFAMI(17) = 'SW'
CFAMI(18) = 'SW'
CFAMI(19) = 'SW'
CFAMI(20) = 'SW'
CFAMI(21) = 'SW'
CFAMI(22) = 'SW'
CFAMI(23) = 'SW'
CFAMI(24) = 'GO'
CFAMI(25) = 'SC'
CFAMI(26) = 'PR'
CFAMI(27) = 'RO'
CFAMI(28) = 'HU'
CFAMI(29) = 'ST'
CFAMI(30) = 'MI'
CFAMI(31) = 'OZ'
CFAMI(32) = 'OZ'
CFAMI(33) = 'GP'
CFAMI(34) = ' '
IER =MRFOPC('MSGLVL','FATAL')
IVALS=8
KDATE=-9999
KTIME=-9999
burp_nfiles=0
DO JJ=1,JPFILES
IF(CLVALU(JJ) == '') EXIT
nulburp=0
burpin=trim(CLVALU(JJ))//'_'//trim(cmyid)
INQUIRE(FILE=trim(burpin),EXIST=isExist_L)
IF (.NOT. isExist_L )THEN
burpin=trim(CLVALU(JJ))
INQUIRE(FILE=trim(burpin),EXIST=isExist_L)
END IF
IF ( isExist_L )THEN
IER=FNOM(nulburp,burpin,'RND+OLD',0)
WRITE(*,*)' Open File : ',burpin
IF ( IER .EQ. 0 ) THEN
INBLKS= -1
INBLKS=NUMBLKS(nulburp)
IF ( INBLKS .GT. 0 ) THEN
INRECS=MRFOPN(NULBURP,'READ')
ILONG =MRFMXL(NULBURP)
ALLOCATE(IBUF(ILONG + 20))
IBUF(1)=ILONG + 20
IHANDL =MRFLOC(NULBURP,0,'>>*******',-1,-1,-1,-1,-1,-1,0)
IF ( IHANDL .LT. 0 ) THEN
IHANDL=MRFLOC(NULBURP,0,'*********',-1,-1,-1,-1,-1,-1,0)
ENDIF
IF ( IHANDL .LT. 0 ) THEN
WRITE(*,*) 'AUCUN ENREGISTREMENT VALIDE DANS LE FICHIER BURP'
ELSE
burp_nfiles=burp_nfiles + 1
burp_cfilnam(burp_nfiles)=burpin
burp_cfamtyp(burp_nfiles)=CFAMI(JJ)
INSUP=0
INXAUX=0
IER=MRFGET(IHANDL,IBUF)
IER=MRBHDR(IBUF,ITIME,IFLGS,CLSTNID,IDBURP,ILAT, &
ILON,IDX,IDY, IALT,IDELAY,IDATE,IRS,IRUNN,INBLK, &
ISUP,INSUP,IXAUX,INXAUX)
KTIME=ITIME
KDATE=IDATE
ENDIF
DEALLOCATE(IBUF)
IER=MRFCLS(NULBURP)
ENDIF
ENDIF
IER= FCLOS(nulburp)
ENDIF
END DO
WRITE(*,*) ' '
WRITE(*,*)' NUMBER OF BURP FILES IS :',burp_nfiles
WRITE(*,*)'TYPE NAME '
WRITE(*,*)'---- ---- '
DO JJ=1,burp_nfiles
WRITE(*,'(1X,A2,1X,A128)' ) burp_cfamtyp(JJ),burp_cfilnam(JJ)
END DO
! Make sure all mpi tasks have a valid date (important for split burp files)
call rpn_comm_allreduce(kdate,kdate,1,"MPI_INTEGER","MPI_MAX","GRID",ier)
call rpn_comm_allreduce(ktime,ktime,1,"MPI_INTEGER","MPI_MAX","GRID",ier)
ier = newdate(istampobs,kdate,ktime,3)
delhh = 3.0d0
call INCDATR (datestamp, istampobs, delhh)
ier = newdate(datestamp,nbrpdate,inewhh,-3)
nbrphh=KTIME/100
if (nbrphh .ge. 21 .or. nbrphh .lt. 3) then
nbrphh = 0
elseif(nbrphh .ge. 3 .and. nbrphh .lt. 9) then
nbrphh = 6
elseif(nbrphh .ge. 9 .and. nbrphh .lt. 15) then
nbrphh = 12
else
nbrphh = 18
endif
ier = newdate(datestamp,nbrpdate,nbrphh*1000000,3)
WRITE(*, *)' BURP FILES VALID DATE (YYYYMMDD) : ',nbrpdate
WRITE(*, *)' BURP FILES VALID TIME (HH) : ',nbrphh
END SUBROUTINE burp_setupfiles
end module burpFiles_mod