132 lines
4.1 KiB
Fortran
Executable File
132 lines
4.1 KiB
Fortran
Executable File
MODULE convmerge
|
|
|
|
USE toolspar_kind
|
|
USE obs_fbm
|
|
USE obs_utils
|
|
IMPLICIT NONE
|
|
|
|
CONTAINS
|
|
|
|
SUBROUTINE conv_fbmerge( cdoutfile, nfiles, fbdata )
|
|
!!---------------------------------------------------------------------
|
|
!!
|
|
!! ** ROUTINE conv_fbmerg **
|
|
!!
|
|
!! ** Purpose : Merge all fbfiles into a single fbfile
|
|
!!
|
|
!! ** Method : Use of utilities from obs_fbm.
|
|
!!
|
|
!! ** Action :
|
|
!!
|
|
!! Optional :
|
|
!! namelist = namobs.in to select the observation range
|
|
!!
|
|
!! History :
|
|
!! ! 2010 (K. Mogensen) Initial version
|
|
!!----------------------------------------------------------------------
|
|
!! * Arguments
|
|
CHARACTER(LEN=*) :: cdoutfile ! Input file.
|
|
INTEGER :: nfiles ! Number of files
|
|
TYPE(obfbdata), dimension(nfiles) :: fbdata ! Structure to merge
|
|
!! * Local variables
|
|
type(obfbdata) :: fbmerge
|
|
INTEGER,ALLOCATABLE :: iset(:),inum(:),iindex(:)
|
|
INTEGER :: nmaxlev
|
|
INTEGER :: ia,ij,ii
|
|
REAL(fbdp), DIMENSION(nfiles) :: djulini, djulend
|
|
CHARACTER(len=8) :: cl_refdate
|
|
INTEGER :: irefdate,iyea,imon,iday,ihou,imin,isec
|
|
! Namelist variables
|
|
CHARACTER(len=9) :: cdnamefile='namobs.in'
|
|
LOGICAL :: lexists
|
|
REAL(fbdp) :: dobsini,dobsend
|
|
NAMELIST/namobs/dobsini,dobsend
|
|
|
|
dobsini = 0.0
|
|
dobsend = 99991231.235959
|
|
|
|
INQUIRE(file=cdnamefile, exist=lexists)
|
|
IF (lexists) THEN
|
|
OPEN(10,file=cdnamefile)
|
|
READ(10,namobs)
|
|
WRITE(*,namobs)
|
|
CLOSE(10)
|
|
ENDIF
|
|
!
|
|
! Count number of data points
|
|
!
|
|
nmaxlev = 1
|
|
ii = 0
|
|
DO ia = 1,nfiles
|
|
IF (lexists) THEN
|
|
cl_refdate=fbdata(ia)%cdjuldref(1:8)
|
|
READ(cl_refdate,'(I8)') irefdate
|
|
CALL ddatetoymdhms( dobsini, iyea, imon, iday, ihou, imin, isec )
|
|
CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(ia), &
|
|
& krefdate = irefdate )
|
|
CALL ddatetoymdhms( dobsend, iyea, imon, iday, ihou, imin, isec )
|
|
CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(ia), &
|
|
& krefdate = irefdate )
|
|
DO ij = 1, fbdata(ia)%nobs
|
|
IF ( ( fbdata(ia)%ptim(ij) > djulini(ia) ) .AND. &
|
|
& ( fbdata(ia)%ptim(ij) <= djulend(ia) ) ) THEN
|
|
ii = ii + 1
|
|
nmaxlev = MAX(nmaxlev,fbdata(ia)%nlev)
|
|
ENDIF
|
|
ENDDO
|
|
ELSE
|
|
nmaxlev = MAX(nmaxlev,fbdata(ia)%nlev)
|
|
ii = ii + fbdata(ia)%nobs
|
|
ENDIF
|
|
ENDDO
|
|
!
|
|
! Merge the input structures into the output structure
|
|
!
|
|
ALLOCATE( iset(ii), inum(ii), iindex(ii))
|
|
ii = 0
|
|
DO ia = 1,nfiles
|
|
DO ij = 1, fbdata(ia)%nobs
|
|
IF (lexists) THEN
|
|
IF ( ( fbdata(ia)%ptim(ij) > djulini(ia) ) .AND. &
|
|
& ( fbdata(ia)%ptim(ij) <= djulend(ia) ) ) THEN
|
|
ii = ii + 1
|
|
iset(ii) = ia
|
|
inum(ii) = ij
|
|
iindex(ii) = ii
|
|
ENDIF
|
|
ELSE
|
|
ii = ii + 1
|
|
iset(ii) = ia
|
|
inum(ii) = ij
|
|
iindex(ii) = ii
|
|
ENDIF
|
|
ENDDO
|
|
ENDDO
|
|
WRITE(*,*)'Output number of observations = ',ii
|
|
WRITE(*,*)'Output number of levels = ',nmaxlev
|
|
!
|
|
! Prepare fbmerge structure
|
|
!
|
|
CALL init_obfbdata( fbmerge )
|
|
CALL alloc_obfbdata( fbmerge, fbdata(1)%nvar, ii, nmaxlev, &
|
|
& fbdata(1)%nadd, fbdata(1)%next, fbdata(1)%lgrid )
|
|
CALL merge_obfbdata( nfiles, fbdata, fbmerge, iset, inum, iindex )
|
|
!
|
|
! Write the file
|
|
!
|
|
CALL write_obfbdata( TRIM(cdoutfile), fbmerge )
|
|
!
|
|
! Dellocate the data
|
|
!
|
|
CALL dealloc_obfbdata( fbmerge )
|
|
|
|
END SUBROUTINE conv_fbmerge
|
|
|
|
#include "ctl_stop.h90"
|
|
|
|
#include "greg2jul.h90"
|
|
|
|
!#include "ddatetoymdhms.h90"
|
|
|
|
END MODULE convmerge
|