[2945] | 1 | PROGRAM fbcomb |
---|
[3000] | 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 | !!---------------------------------------------------------------------- |
---|
[2945] | 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(:) |
---|
[3000] | 41 | INTEGER :: iwmo |
---|
[2945] | 42 | ! |
---|
| 43 | ! Output data |
---|
| 44 | ! |
---|
| 45 | TYPE(obfbdata) :: obsoutdata |
---|
| 46 | ! |
---|
| 47 | ! Loop variables |
---|
| 48 | ! |
---|
[3000] | 49 | INTEGER :: ia,iv,ii,ij |
---|
[2945] | 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 | ! |
---|
[3000] | 79 | DO ia=2, ninfiles |
---|
| 80 | IF ( obsdata(ia)%cdjuldref /= obsdata(1)%cdjuldref ) THEN |
---|
[2945] | 81 | WRITE(*,*)'Different julian date reference. Aborting' |
---|
| 82 | CALL abort |
---|
| 83 | ENDIF |
---|
[3000] | 84 | IF ( obsdata(ia)%nvar /= obsdata(1)%nvar ) THEN |
---|
[2945] | 85 | WRITE(*,*)'Different number of variables. Aborting' |
---|
| 86 | CALL abort |
---|
| 87 | ENDIF |
---|
[3000] | 88 | IF (obsdata(ia)%nadd /= obsdata(1)%nadd ) THEN |
---|
[2945] | 89 | WRITE(*,*)'Different number of additional entries. Aborting' |
---|
| 90 | CALL abort |
---|
| 91 | ENDIF |
---|
[3000] | 92 | IF ( obsdata(ia)%next /= obsdata(1)%next ) THEN |
---|
[2945] | 93 | WRITE(*,*)'Different number of additional variables. Aborting' |
---|
| 94 | CALL abort |
---|
| 95 | ENDIF |
---|
[3000] | 96 | IF ( obsdata(ia)%lgrid .NEQV. obsdata(1)%lgrid ) THEN |
---|
[2945] | 97 | WRITE(*,*)'Inconsistent grid search info. Aborting' |
---|
| 98 | CALL abort |
---|
| 99 | ENDIF |
---|
| 100 | DO iv=1, obsdata(ia)%nvar |
---|
[3000] | 101 | IF ( obsdata(ia)%cname(iv) /= obsdata(1)%cname(iv) ) THEN |
---|
[2945] | 102 | WRITE(*,*)'Variable name ', TRIM(obsdata(ia)%cname(iv)), & |
---|
[3000] | 103 | & ' is different from ', TRIM(obsdata(1)%cname(iv)), & |
---|
[2945] | 104 | & '. Aborting' |
---|
| 105 | CALL abort |
---|
| 106 | ENDIF |
---|
[3000] | 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 |
---|
[2945] | 119 | ENDIF |
---|
| 120 | ENDIF |
---|
| 121 | ENDDO |
---|
| 122 | DO iv=1,obsdata(ia)%nadd |
---|
[3000] | 123 | IF ( obsdata(ia)%caddname(iv) /= obsdata(1)%caddname(iv) ) THEN |
---|
[2945] | 124 | WRITE(*,*)'Additional name ', TRIM(obsdata(ia)%caddname(iv)), & |
---|
[3000] | 125 | & ' is different from ', TRIM(obsdata(1)%caddname(iv)), & |
---|
[2945] | 126 | & '. Aborting' |
---|
| 127 | CALL abort |
---|
| 128 | ENDIF |
---|
| 129 | ENDDO |
---|
| 130 | DO iv=1,obsdata(ia)%next |
---|
[3000] | 131 | IF ( obsdata(ia)%cextname(iv) /= obsdata(1)%cextname(iv) ) THEN |
---|
[2945] | 132 | WRITE(*,*)'Extra name ', TRIM(obsdata(ia)%cextname(iv)), & |
---|
[3000] | 133 | & ' is different from ', TRIM(obsdata(1)%cextname(iv)), & |
---|
[2945] | 134 | & '. Aborting' |
---|
| 135 | CALL abort |
---|
| 136 | ENDIF |
---|
| 137 | ENDDO |
---|
| 138 | ENDDO |
---|
| 139 | ! |
---|
| 140 | ! Construct sorting arrays |
---|
| 141 | ! |
---|
[3000] | 142 | ALLOCATE( zsort(5,ntotobs), iset(ntotobs), & |
---|
[2945] | 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) |
---|
[3000] | 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 |
---|
[2945] | 155 | iset(ii) = ia |
---|
| 156 | inum(ii) = ij |
---|
| 157 | ENDDO |
---|
| 158 | ENDDO |
---|
| 159 | ! |
---|
| 160 | ! Get indexes for time sorting. |
---|
| 161 | ! |
---|
[3000] | 162 | CALL index_sort_dp_n(zsort,5,iindex,ntotobs) |
---|
[2945] | 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 ) |
---|
[3000] | 171 | CALL alloc_obfbdata( obsoutdata, obsdata(1)%nvar, ntotobs, nlev, & |
---|
| 172 | & obsdata(1)%nadd, obsdata(1)%next, obsdata(1)%lgrid ) |
---|
[2945] | 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 |
---|