1 | PROGRAM fbcomb |
---|
2 | !!--------------------------------------------------------------------- |
---|
3 | !! |
---|
4 | !! ** PROGRAM fbcomb ** |
---|
5 | !! |
---|
6 | !! ** Purpose : Combine MPI decomposed feedback files into one file |
---|
7 | !! |
---|
8 | !! ** Method : Use of utilities from obs_fbm. |
---|
9 | !! |
---|
10 | !! ** Action : |
---|
11 | !! |
---|
12 | !! Usage: |
---|
13 | !! fbcomb.exe outputfile inputfile1 inputfile2 ... |
---|
14 | !! |
---|
15 | !! History : |
---|
16 | !! ! 2010 (K. Mogensen) Initial version |
---|
17 | !!---------------------------------------------------------------------- |
---|
18 | USE toolspar_kind |
---|
19 | USE obs_fbm |
---|
20 | USE index_sort |
---|
21 | IMPLICIT NONE |
---|
22 | ! |
---|
23 | ! Command line arguments for output file and input file |
---|
24 | ! |
---|
25 | #ifndef NOIARGCPROTO |
---|
26 | INTEGER,EXTERNAL :: iargc |
---|
27 | #endif |
---|
28 | INTEGER :: nargs |
---|
29 | CHARACTER(len=256) :: cdoutfile |
---|
30 | CHARACTER(len=256),ALLOCATABLE :: cdinfile(:) |
---|
31 | ! |
---|
32 | ! Input data |
---|
33 | ! |
---|
34 | TYPE(obfbdata),POINTER :: obsdata(:) |
---|
35 | INTEGER :: ninfiles,ntotobs,nlev |
---|
36 | ! |
---|
37 | ! Time sorting arrays |
---|
38 | ! |
---|
39 | REAL(KIND=dp),ALLOCATABLE :: zsort(:,:) |
---|
40 | INTEGER,ALLOCATABLE :: iset(:),inum(:),iindex(:) |
---|
41 | INTEGER :: iwmo |
---|
42 | ! |
---|
43 | ! Output data |
---|
44 | ! |
---|
45 | TYPE(obfbdata) :: obsoutdata |
---|
46 | ! |
---|
47 | ! Loop variables |
---|
48 | ! |
---|
49 | INTEGER :: ia,iv,ii,ij |
---|
50 | ! |
---|
51 | ! Get number of command line arguments |
---|
52 | ! |
---|
53 | nargs = IARGC() |
---|
54 | IF ( nargs < 2 ) THEN |
---|
55 | WRITE(*,'(A)')'Usage:' |
---|
56 | WRITE(*,'(A)')'fbcomb outputfile inputfile1 inputfile2 ...' |
---|
57 | CALL abort() |
---|
58 | ENDIF |
---|
59 | CALL getarg( 1, cdoutfile ) |
---|
60 | ! |
---|
61 | ! Get input data |
---|
62 | ! |
---|
63 | ALLOCATE( obsdata( nargs - 1 ) ) |
---|
64 | ALLOCATE( cdinfile( nargs - 1 ) ) |
---|
65 | ntotobs = 0 |
---|
66 | ninfiles = nargs - 1 |
---|
67 | DO ia=1, ninfiles |
---|
68 | CALL getarg( ia+1, cdinfile(ia) ) |
---|
69 | CALL init_obfbdata( obsdata(ia) ) |
---|
70 | CALL read_obfbdata( TRIM(cdinfile(ia)), obsdata(ia) ) |
---|
71 | WRITE(*,'(2A)')'File = ', TRIM(cdinfile(ia)) |
---|
72 | WRITE(*,'(A,I9,A)')'has', obsdata(ia)%nobs, ' observations' |
---|
73 | ntotobs = ntotobs + obsdata(ia)%nobs |
---|
74 | ENDDO |
---|
75 | WRITE(*,'(A,I8)') 'Total obsfiles : ',ntotobs |
---|
76 | ! |
---|
77 | ! Check that the data is confirming |
---|
78 | ! |
---|
79 | DO ia=2, ninfiles |
---|
80 | IF ( obsdata(ia)%cdjuldref /= obsdata(1)%cdjuldref ) THEN |
---|
81 | WRITE(*,*)'Different julian date reference. Aborting' |
---|
82 | CALL abort |
---|
83 | ENDIF |
---|
84 | IF ( obsdata(ia)%nvar /= obsdata(1)%nvar ) THEN |
---|
85 | WRITE(*,*)'Different number of variables. Aborting' |
---|
86 | CALL abort |
---|
87 | ENDIF |
---|
88 | IF (obsdata(ia)%nadd /= obsdata(1)%nadd ) THEN |
---|
89 | WRITE(*,*)'Different number of additional entries. Aborting' |
---|
90 | CALL abort |
---|
91 | ENDIF |
---|
92 | IF ( obsdata(ia)%next /= obsdata(1)%next ) THEN |
---|
93 | WRITE(*,*)'Different number of additional variables. Aborting' |
---|
94 | CALL abort |
---|
95 | ENDIF |
---|
96 | IF ( obsdata(ia)%lgrid .NEQV. obsdata(1)%lgrid ) THEN |
---|
97 | WRITE(*,*)'Inconsistent grid search info. Aborting' |
---|
98 | CALL abort |
---|
99 | ENDIF |
---|
100 | DO iv=1, obsdata(ia)%nvar |
---|
101 | IF ( obsdata(ia)%cname(iv) /= obsdata(1)%cname(iv) ) THEN |
---|
102 | WRITE(*,*)'Variable name ', TRIM(obsdata(ia)%cname(iv)), & |
---|
103 | & ' is different from ', TRIM(obsdata(1)%cname(iv)), & |
---|
104 | & '. Aborting' |
---|
105 | CALL abort |
---|
106 | ENDIF |
---|
107 | IF ( obsdata(1)%lgrid ) THEN |
---|
108 | IF ( obsdata(ia)%cgrid(iv) /= obsdata(1)%cgrid(iv) ) THEN |
---|
109 | IF (obsdata(1)%nobs==0) THEN |
---|
110 | obsdata(1)%cgrid(iv) = obsdata(ia)%cgrid(iv) |
---|
111 | ELSE |
---|
112 | IF (obsdata(ia)%nobs>0) THEN |
---|
113 | WRITE(*,*)'Grid name ', TRIM(obsdata(ia)%cgrid(iv)), & |
---|
114 | & ' is different from ', & |
---|
115 | & TRIM(obsdata(1)%cgrid(iv)), '. Aborting' |
---|
116 | CALL abort |
---|
117 | ENDIF |
---|
118 | ENDIF |
---|
119 | ENDIF |
---|
120 | ENDIF |
---|
121 | ENDDO |
---|
122 | DO iv=1,obsdata(ia)%nadd |
---|
123 | IF ( obsdata(ia)%caddname(iv) /= obsdata(1)%caddname(iv) ) THEN |
---|
124 | WRITE(*,*)'Additional name ', TRIM(obsdata(ia)%caddname(iv)), & |
---|
125 | & ' is different from ', TRIM(obsdata(1)%caddname(iv)), & |
---|
126 | & '. Aborting' |
---|
127 | CALL abort |
---|
128 | ENDIF |
---|
129 | ENDDO |
---|
130 | DO iv=1,obsdata(ia)%next |
---|
131 | IF ( obsdata(ia)%cextname(iv) /= obsdata(1)%cextname(iv) ) THEN |
---|
132 | WRITE(*,*)'Extra name ', TRIM(obsdata(ia)%cextname(iv)), & |
---|
133 | & ' is different from ', TRIM(obsdata(1)%cextname(iv)), & |
---|
134 | & '. Aborting' |
---|
135 | CALL abort |
---|
136 | ENDIF |
---|
137 | ENDDO |
---|
138 | ENDDO |
---|
139 | ! |
---|
140 | ! Construct sorting arrays |
---|
141 | ! |
---|
142 | ALLOCATE( zsort(5,ntotobs), iset(ntotobs), & |
---|
143 | & inum(ntotobs), iindex(ntotobs)) |
---|
144 | ii = 0 |
---|
145 | DO ia = 1,ninfiles |
---|
146 | DO ij = 1,obsdata(ia)%nobs |
---|
147 | ii = ii+1 |
---|
148 | zsort(1,ii) = obsdata(ia)%ptim(ij) |
---|
149 | zsort(2,ii) = obsdata(ia)%pphi(ij) |
---|
150 | zsort(3,ii) = obsdata(ia)%plam(ij) |
---|
151 | iwmo = TRANSFER( obsdata(ia)%cdwmo(ij)(1:4), iwmo ) |
---|
152 | zsort(4,ii) = iwmo |
---|
153 | iwmo = TRANSFER( obsdata(ia)%cdwmo(ij)(5:8), iwmo ) |
---|
154 | zsort(5,ii) = iwmo |
---|
155 | iset(ii) = ia |
---|
156 | inum(ii) = ij |
---|
157 | ENDDO |
---|
158 | ENDDO |
---|
159 | ! |
---|
160 | ! Get indexes for time sorting. |
---|
161 | ! |
---|
162 | CALL index_sort_dp_n(zsort,5,iindex,ntotobs) |
---|
163 | ! |
---|
164 | ! Allocate output data |
---|
165 | ! |
---|
166 | nlev = -1 |
---|
167 | DO ia = 1,ninfiles |
---|
168 | IF ( obsdata(ia)%nlev > nlev ) nlev = obsdata(ia)%nlev |
---|
169 | ENDDO |
---|
170 | CALL init_obfbdata( obsoutdata ) |
---|
171 | CALL alloc_obfbdata( obsoutdata, obsdata(1)%nvar, ntotobs, nlev, & |
---|
172 | & obsdata(1)%nadd, obsdata(1)%next, obsdata(1)%lgrid ) |
---|
173 | ! |
---|
174 | ! Copy input data into output data |
---|
175 | ! |
---|
176 | CALL merge_obfbdata( ninfiles, obsdata, obsoutdata, iset, inum, iindex ) |
---|
177 | ! |
---|
178 | ! Save output data |
---|
179 | ! |
---|
180 | CALL write_obfbdata ( TRIM(cdoutfile), obsoutdata ) |
---|
181 | |
---|
182 | END PROGRAM fbcomb |
---|