New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
convmerge.F90 in branches/dev_2802_OBStools/NEMOGCM/TOOLS/OBSTOOLS – NEMO

source: branches/dev_2802_OBStools/NEMOGCM/TOOLS/OBSTOOLS/convmerge.F90 @ 2893

Last change on this file since 2893 was 2893, checked in by djlea, 13 years ago

Adding obs tools to branch

File size: 3.9 KB
Line 
1MODULE convmerge
2
3   USE toolspar_kind
4   USE obs_fbm
5   IMPLICIT NONE
6
7CONTAINS
8
9   SUBROUTINE conv_fbmerge( cdoutfile, nfiles, fbdata )
10      !!---------------------------------------------------------------------
11      !!
12      !!                     ** ROUTINE conv_fbmerg **
13      !!
14      !!  ** Purpose : Merge all fbfiles into a single fbfile
15      !!
16      !!  ** Method  : Use of utilities from obs_fbm.
17      !!
18      !!  ** Action  :
19      !!
20      !!   History :
21      !!----------------------------------------------------------------------
22      !! * Arguments
23      CHARACTER(LEN=*) :: cdoutfile                ! Input file.
24      INTEGER :: nfiles                            ! Number of files
25      TYPE(obfbdata), dimension(nfiles) :: fbdata  ! Structure to merge
26      !! * Local variables
27      type(obfbdata) :: fbmerge
28      INTEGER,ALLOCATABLE  :: iset(:),inum(:),iindex(:)
29      INTEGER :: nmaxlev
30      INTEGER :: ia,ij,ii
31      REAL(fbdp), DIMENSION(nfiles) :: djulini, djulend
32      CHARACTER(len=8) :: cl_refdate
33      INTEGER :: irefdate,iyea,imon,iday,ihou,imin,isec
34      ! Namelist variables
35      CHARACTER(len=9) :: cdnamefile='namobs.in'
36      LOGICAL :: lexists 
37      REAL(fbdp) :: dobsini,dobsend
38      NAMELIST/namobs/dobsini,dobsend
39     
40      dobsini = 0.0
41      dobsend = 99991231.235959
42
43      INQUIRE(file=cdnamefile, exist=lexists)
44      IF (lexists) THEN
45         OPEN(10,file=cdnamefile)
46         READ(10,namobs)
47         WRITE(*,namobs)
48         CLOSE(10)
49      ENDIF
50      !
51      ! Count number of data points
52      !
53      nmaxlev = 1
54      ii = 0
55      DO ia = 1,nfiles
56         IF (lexists) THEN
57            cl_refdate=fbdata(ia)%cdjuldref(1:8)
58            READ(cl_refdate,'(I8)') irefdate
59            CALL ddatetoymdhms( dobsini, iyea, imon, iday, ihou, imin, isec )
60            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(ia), &
61               &           krefdate = irefdate )
62            CALL ddatetoymdhms( dobsend, iyea, imon, iday, ihou, imin, isec )
63            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(ia), &
64            &           krefdate = irefdate )
65            DO ij = 1, fbdata(ia)%nobs
66               IF ( ( fbdata(ia)%ptim(ij) >  djulini(ia) ) .AND. &
67                  & ( fbdata(ia)%ptim(ij) <= djulend(ia) ) ) THEN
68                  ii = ii + 1
69                  nmaxlev = MAX(nmaxlev,fbdata(ia)%nlev)
70               ENDIF
71            ENDDO
72         ELSE
73            nmaxlev = MAX(nmaxlev,fbdata(ia)%nlev)
74            ii = ii + fbdata(ia)%nobs
75         ENDIF
76      ENDDO
77      !
78      ! Merge the input structures into the output structure
79      !
80      ALLOCATE( iset(ii), inum(ii), iindex(ii))
81      ii = 0
82      DO ia = 1,nfiles
83         DO ij = 1, fbdata(ia)%nobs
84            IF (lexists) THEN
85               IF ( ( fbdata(ia)%ptim(ij) >  djulini(ia) ) .AND. &
86                  & ( fbdata(ia)%ptim(ij) <= djulend(ia) ) ) THEN
87                  ii = ii + 1
88                  iset(ii)   = ia
89                  inum(ii)   = ij
90                  iindex(ii) = ii
91               ENDIF
92            ELSE
93               ii = ii + 1
94               iset(ii)   = ia
95               inum(ii)   = ij
96               iindex(ii) = ii
97            ENDIF
98         ENDDO
99      ENDDO
100      WRITE(*,*)'Output number of observations = ',ii
101      WRITE(*,*)'Output number of levels       = ',nmaxlev
102      !
103      ! Prepare fbmerge structure
104      !
105      CALL init_obfbdata( fbmerge )
106      CALL alloc_obfbdata( fbmerge, fbdata(1)%nvar, ii, nmaxlev, &
107         &                 fbdata(1)%nadd, fbdata(1)%next, fbdata(1)%lgrid )
108      CALL merge_obfbdata( nfiles, fbdata, fbmerge, iset, inum, iindex )
109      !
110      ! Write the file
111      !
112      CALL write_obfbdata( TRIM(cdoutfile), fbmerge )
113      !
114      ! Dellocate the data
115      !
116      CALL dealloc_obfbdata( fbmerge )
117
118   END SUBROUTINE conv_fbmerge
119
120#include "ctl_stop.h90"
121
122#include "greg2jul.h90"
123
124#include "ddatetoymdhms.h90"
125
126END MODULE convmerge
Note: See TracBrowser for help on using the repository browser.