[4112] | 1 | PROGRAM c4comb |
---|
| 2 | !!--------------------------------------------------------------------- |
---|
| 3 | !! |
---|
| 4 | !! ** PROGRAM c4comb ** |
---|
| 5 | !! |
---|
| 6 | !! ** Purpose : Combine MPI decomposed class4 files into one file |
---|
| 7 | !! |
---|
| 8 | !! ** Method : Use of utilities from obs_utils, ooo_utils. |
---|
| 9 | !! |
---|
| 10 | !! ** Action : |
---|
| 11 | !! |
---|
| 12 | !! Usage: |
---|
[4124] | 13 | !! c4comb.exe outputfile inputfile1 inputfile2 ... |
---|
[4112] | 14 | !! |
---|
| 15 | !! History : |
---|
| 16 | !!---------------------------------------------------------------------- |
---|
| 17 | USE netcdf |
---|
| 18 | USE obs_const |
---|
| 19 | USE obs_utils |
---|
| 20 | USE ooo_utils, ONLY: date_format, obfilldbl |
---|
| 21 | USE toolspar_kind |
---|
| 22 | IMPLICIT NONE |
---|
| 23 | !! Command line setup |
---|
| 24 | #ifndef NOIARGCPROTO |
---|
| 25 | INTEGER,EXTERNAL :: iargc |
---|
| 26 | #endif |
---|
[4124] | 27 | INTEGER :: nargs, & !: number of command line arguments |
---|
| 28 | & ia, & !: argument loop index |
---|
| 29 | & ninfiles !: number of input files |
---|
[4112] | 30 | !! Routine arguments |
---|
[4124] | 31 | CHARACTER(len=256) :: cdoutfile |
---|
| 32 | CHARACTER(len=256),ALLOCATABLE :: cdinfile(:) |
---|
[4112] | 33 | !! Routine variables |
---|
[4124] | 34 | CHARACTER(len=80) :: cpname |
---|
[4112] | 35 | INTEGER,PARAMETER :: nstr=8, n128=128 |
---|
| 36 | INTEGER :: ncid, & !: netcdf file id |
---|
| 37 | & dimid, & !: netcdf dimension id |
---|
| 38 | & dpdim, & !: netcdf dimension ids |
---|
| 39 | & fcdim, & |
---|
| 40 | & vrdim, & |
---|
| 41 | & obdim, & |
---|
| 42 | & stdim, & |
---|
| 43 | & sxdim, & |
---|
| 44 | & fdvid, & !: netcdf variable ids |
---|
| 45 | & lonid, & |
---|
| 46 | & latid, & |
---|
| 47 | & depid, & |
---|
| 48 | & varid, & |
---|
| 49 | & unitid, & |
---|
| 50 | & obvid, & |
---|
| 51 | & fcvid, & |
---|
| 52 | & prvid, & |
---|
| 53 | & clvid, & |
---|
| 54 | & dm2id, & |
---|
| 55 | & dm1id, & |
---|
| 56 | & mdtid, & |
---|
| 57 | & altid, & |
---|
| 58 | & qcvid, & |
---|
| 59 | & jdvid, & |
---|
| 60 | & mjdid, & |
---|
| 61 | & typid, & |
---|
| 62 | & idvid, & |
---|
| 63 | & ndeps, & !: number depths |
---|
| 64 | & nfcst, & !: number forecast |
---|
| 65 | & nvars, & !: number variables |
---|
| 66 | & nobs, & !: number obs |
---|
| 67 | & sdeps, & |
---|
| 68 | & sobs, & |
---|
| 69 | & l_dex, & |
---|
| 70 | & u_dex |
---|
| 71 | |
---|
[4124] | 72 | INTEGER :: iob, idep, istat |
---|
[4112] | 73 | INTEGER, DIMENSION(2) :: dim2a, dim2b, dim2c, dim2d |
---|
| 74 | INTEGER, DIMENSION(3) :: dim3a |
---|
| 75 | INTEGER, DIMENSION(4) :: dim4a |
---|
| 76 | INTEGER, ALLOCATABLE, DIMENSION(:) :: fcday |
---|
| 77 | REAL(wp), ALLOCATABLE, DIMENSION(:) :: modjd |
---|
| 78 | !: Global Attributes |
---|
| 79 | CHARACTER(len=40) :: nam_str, & |
---|
| 80 | & version, & |
---|
| 81 | & contact, & |
---|
| 82 | & sys_str, & |
---|
| 83 | & cfg_str, & |
---|
| 84 | & ins_str, & |
---|
| 85 | & val_str, & |
---|
| 86 | & dat_str, & |
---|
| 87 | & obs_str |
---|
| 88 | !: Variable Attributes |
---|
| 89 | CHARACTER(len=100) :: lon_units, & |
---|
| 90 | & lat_units, & |
---|
| 91 | & dep_units, & |
---|
| 92 | & jul_units, & |
---|
| 93 | & mjd_units, & |
---|
| 94 | & fcd_units, & |
---|
| 95 | & lead_comment, & |
---|
| 96 | & fcst_comment, & |
---|
| 97 | & per_comment, & |
---|
| 98 | & cli_comment, & |
---|
| 99 | & dm2_comment, & |
---|
| 100 | & dm1_comment |
---|
| 101 | CHARACTER(len=128) :: qc_comment, & |
---|
| 102 | & qc_flag_meaning |
---|
| 103 | INTEGER, DIMENSION(2) :: qc_flag_value |
---|
| 104 | |
---|
| 105 | !: Global Arrays |
---|
| 106 | REAL(wp), ALLOCATABLE, DIMENSION(:) :: g_lam, & |
---|
| 107 | & g_phi, & |
---|
| 108 | & gjuld |
---|
| 109 | CHARACTER(len=n128),ALLOCATABLE,DIMENSION(:) :: gtype |
---|
| 110 | CHARACTER(len=nstr),ALLOCATABLE,DIMENSION(:) :: & |
---|
| 111 | & g_id, & |
---|
| 112 | & gvnam, & |
---|
| 113 | & gunit |
---|
| 114 | REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: g_dep |
---|
| 115 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: g3dob, & |
---|
| 116 | & g3dcl, & |
---|
| 117 | & g3mdt, & |
---|
| 118 | & g3alt, & |
---|
| 119 | & g3dm2, & |
---|
| 120 | & g3dm1 |
---|
| 121 | INTEGER(ik), ALLOCATABLE, DIMENSION(:,:,:) :: g3dqc |
---|
| 122 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: g3dmc, & |
---|
| 123 | & g3dpr |
---|
| 124 | !: Small Arrays |
---|
| 125 | REAL(wp), ALLOCATABLE, DIMENSION(:) :: s_lam, & |
---|
| 126 | & s_phi, & |
---|
| 127 | & sjuld |
---|
| 128 | |
---|
| 129 | CHARACTER(len=n128),ALLOCATABLE,DIMENSION(:) :: stype |
---|
| 130 | CHARACTER(len=nstr),ALLOCATABLE,DIMENSION(:) :: & |
---|
| 131 | & s_id |
---|
| 132 | |
---|
| 133 | REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: s_dep |
---|
| 134 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: s3dob, & |
---|
| 135 | & s3dcl, & |
---|
| 136 | & s3mdt, & |
---|
| 137 | & s3alt, & |
---|
| 138 | & s3dm2, & |
---|
| 139 | & s3dm1 |
---|
| 140 | INTEGER(ik), ALLOCATABLE, DIMENSION(:,:,:) :: s3dqc |
---|
| 141 | REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: s3dmc, & |
---|
| 142 | & s3dpr |
---|
| 143 | |
---|
| 144 | !: File creation logical |
---|
| 145 | LOGICAL :: ln_cre |
---|
| 146 | |
---|
| 147 | !: Optional variable logicals |
---|
| 148 | LOGICAL :: ln_init, & |
---|
| 149 | & ln_mdt, & |
---|
| 150 | & ln_altbias, & |
---|
| 151 | & ln_best |
---|
| 152 | !! Command name |
---|
| 153 | cpname='c4comb.exe' |
---|
| 154 | |
---|
| 155 | !! Process command line |
---|
| 156 | nargs = IARGC() |
---|
| 157 | IF (nargs /= 2) THEN |
---|
[4124] | 158 | WRITE(*, *) "Usage: c4comb.exe outputfile inputfile1 inputfile2 ..." |
---|
| 159 | CALL abort() |
---|
[4112] | 160 | END IF |
---|
[4124] | 161 | CALL GETARG(1, cdoutfile) |
---|
[4112] | 162 | |
---|
| 163 | !! Process input files |
---|
| 164 | !! Set output file creation to off |
---|
| 165 | ln_cre = .false. |
---|
| 166 | |
---|
| 167 | !! Turn optional variables off |
---|
| 168 | ln_init = .false. |
---|
| 169 | ln_best = .false. |
---|
| 170 | ln_altbias = .false. |
---|
| 171 | ln_mdt = .false. |
---|
| 172 | |
---|
| 173 | !! Compute size of output file |
---|
| 174 | nobs = 0 |
---|
| 175 | ndeps= 0 |
---|
[4124] | 176 | ALLOCATE( cdinfile( nargs - 1 ) ) |
---|
| 177 | ninfiles = nargs - 1 |
---|
| 178 | DO ia = 1, ninfiles |
---|
| 179 | CALL GETARG(ia+1, cdinfile(ia)) |
---|
| 180 | WRITE(*,*) "Opening : ", TRIM(cdinfile(ia)) |
---|
[4112] | 181 | !! Open Netcdf file |
---|
[4124] | 182 | istat = nf90_open(TRIM(cdinfile(ia)),nf90_nowrite,ncid) |
---|
[4112] | 183 | IF (istat == nf90_noerr) THEN |
---|
| 184 | !! Turn output file creation on |
---|
| 185 | ln_cre = .true. |
---|
| 186 | !! Get Dimensions |
---|
| 187 | CALL chkerr( nf90_inq_dimid(ncid, 'numobs', dimid), cpname, __LINE__ ) |
---|
| 188 | CALL chkerr( nf90_inquire_dimension(ncid, dimid, len=sobs ), cpname, __LINE__ ) |
---|
| 189 | CALL chkerr( nf90_inq_dimid(ncid, 'numdeps', dimid), cpname, __LINE__ ) |
---|
| 190 | CALL chkerr( nf90_inquire_dimension(ncid, dimid, len=sdeps ), cpname, __LINE__ ) |
---|
| 191 | CALL chkerr( nf90_inq_dimid(ncid, 'numfcsts',dimid), cpname, __LINE__ ) |
---|
| 192 | CALL chkerr( nf90_inquire_dimension(ncid, dimid, len=nfcst ), cpname, __LINE__ ) |
---|
| 193 | CALL chkerr( nf90_inq_dimid(ncid, 'numvars', dimid), cpname, __LINE__ ) |
---|
| 194 | CALL chkerr( nf90_inquire_dimension(ncid, dimid, len=nvars ), cpname, __LINE__ ) |
---|
| 195 | !! Close Netcdf file |
---|
| 196 | CALL chkerr( nf90_close(ncid), cpname, __LINE__ ) |
---|
[4124] | 197 | !! Report on file contents |
---|
| 198 | WRITE(*,'(2A)')'File = ', TRIM(cdinfile(ia)) |
---|
| 199 | WRITE(*,'(A,I9,A)')'has', sobs, ' observations' |
---|
[4112] | 200 | !! Increment size |
---|
| 201 | nobs = nobs + sobs !: Accumulate number of profiles |
---|
| 202 | ndeps = MAX(ndeps, sdeps) !: Define maximum number of levels needed |
---|
| 203 | END IF ! istat |
---|
| 204 | END DO |
---|
| 205 | |
---|
| 206 | !! Allocate global arrays |
---|
| 207 | ALLOCATE( g_phi(nobs), & |
---|
| 208 | & g_lam(nobs), & |
---|
| 209 | & g_dep(ndeps, nobs), & |
---|
| 210 | & g3dob(ndeps, nvars, nobs), & |
---|
| 211 | & g3dmc(ndeps, nfcst, nvars, nobs), & |
---|
| 212 | & g3dpr(ndeps, nfcst, nvars, nobs), & |
---|
| 213 | & g3dcl(ndeps, nvars, nobs), & |
---|
| 214 | & g3dm2(ndeps, nvars, nobs), & |
---|
| 215 | & g3dm1(ndeps, nvars, nobs), & |
---|
| 216 | & g3mdt(ndeps, nvars, nobs), & |
---|
| 217 | & g3alt(ndeps, nvars, nobs), & |
---|
| 218 | & g3dqc(ndeps, nvars, nobs), & |
---|
| 219 | & gjuld(nobs), & |
---|
| 220 | & gtype(nobs), & |
---|
| 221 | & g_id(nobs), & |
---|
| 222 | & gvnam(nvars), & |
---|
| 223 | & gunit(nvars) ) |
---|
| 224 | ALLOCATE(fcday(nfcst), modjd(nfcst)) |
---|
| 225 | |
---|
| 226 | !! Fill with missing data value |
---|
| 227 | g_dep(:,:) = 99999. |
---|
| 228 | g3dmc(:,:,:,:) = 99999. |
---|
| 229 | g3dpr(:,:,:,:) = 99999. |
---|
| 230 | g3dob(:,:,:) = 99999. |
---|
| 231 | g3dcl(:,:,:) = 99999. |
---|
| 232 | g3dm2(:,:,:) = 99999. |
---|
| 233 | g3dm1(:,:,:) = 99999. |
---|
| 234 | g3mdt(:,:,:) = 99999. |
---|
| 235 | g3alt(:,:,:) = 99999. |
---|
| 236 | g3dqc(:,:,:) = NF90_FILL_SHORT |
---|
| 237 | |
---|
| 238 | !! Read in each file |
---|
| 239 | ! initialise global matrix indices |
---|
| 240 | l_dex = 0 |
---|
| 241 | u_dex = 0 |
---|
| 242 | |
---|
| 243 | !! initialise Global attribute strings |
---|
| 244 | nam_str = '' |
---|
| 245 | version = '' |
---|
| 246 | contact = '' |
---|
| 247 | sys_str = '' |
---|
| 248 | cfg_str = '' |
---|
| 249 | ins_str = '' |
---|
| 250 | val_str = '' |
---|
| 251 | dat_str = '' |
---|
| 252 | obs_str = '' |
---|
| 253 | |
---|
| 254 | !! initialise Variable attribute strings |
---|
| 255 | fcd_units = '' |
---|
| 256 | lon_units = '' |
---|
| 257 | lat_units = '' |
---|
| 258 | dep_units = '' |
---|
| 259 | jul_units = '' |
---|
| 260 | mjd_units = '' |
---|
| 261 | lead_comment = '' |
---|
| 262 | fcst_comment = '' |
---|
| 263 | per_comment = '' |
---|
| 264 | cli_comment = '' |
---|
| 265 | dm2_comment = '' |
---|
| 266 | dm1_comment = '' |
---|
| 267 | qc_comment = '' |
---|
| 268 | qc_flag_meaning = '' |
---|
| 269 | |
---|
[4124] | 270 | DO ia = 1, ninfiles |
---|
| 271 | WRITE(*,*) "Opening : ", TRIM(cdinfile(ia)) |
---|
[4112] | 272 | !! Open Netcdf file |
---|
[4124] | 273 | istat = nf90_open(TRIM(cdinfile(ia)),nf90_nowrite,ncid) |
---|
[4112] | 274 | IF (istat == nf90_noerr) THEN |
---|
| 275 | !! Get Global Attributes |
---|
| 276 | CALL chkerr( nf90_get_att(ncid, nf90_global,'title', nam_str),cpname, __LINE__) |
---|
| 277 | CALL chkerr( nf90_get_att(ncid, nf90_global,'version', version),cpname, __LINE__) |
---|
| 278 | CALL chkerr( nf90_get_att(ncid, nf90_global,'contact', contact),cpname, __LINE__) |
---|
| 279 | CALL chkerr( nf90_get_att(ncid, nf90_global,'obs_type', obs_str),cpname, __LINE__) |
---|
| 280 | CALL chkerr( nf90_get_att(ncid, nf90_global,'system', sys_str),cpname, __LINE__) |
---|
| 281 | CALL chkerr( nf90_get_att(ncid, nf90_global,'configuration', cfg_str),cpname, __LINE__) |
---|
| 282 | CALL chkerr( nf90_get_att(ncid, nf90_global,'institution', ins_str),cpname, __LINE__) |
---|
| 283 | CALL chkerr( nf90_get_att(ncid, nf90_global,'validity_time', val_str),cpname, __LINE__) |
---|
| 284 | !! Get Dimensions of single file |
---|
| 285 | CALL chkerr( nf90_inq_dimid(ncid, 'numdeps', dimid), cpname, __LINE__ ) |
---|
| 286 | CALL chkerr( nf90_inquire_dimension(ncid, dimid, len=sdeps ), cpname, __LINE__ ) |
---|
| 287 | CALL chkerr( nf90_inq_dimid(ncid, 'numfcsts',dimid), cpname, __LINE__ ) |
---|
| 288 | CALL chkerr( nf90_inquire_dimension(ncid, dimid, len=nfcst ), cpname, __LINE__ ) |
---|
| 289 | CALL chkerr( nf90_inq_dimid(ncid, 'numvars', dimid), cpname, __LINE__ ) |
---|
| 290 | CALL chkerr( nf90_inquire_dimension(ncid, dimid, len=nvars ), cpname, __LINE__ ) |
---|
| 291 | CALL chkerr( nf90_inq_dimid(ncid, 'numobs', dimid), cpname, __LINE__ ) |
---|
| 292 | CALL chkerr( nf90_inquire_dimension(ncid, dimid, len=sobs ), cpname, __LINE__ ) |
---|
| 293 | !! Check for Optional variables in first file |
---|
[4124] | 294 | IF (ia == 1) THEN |
---|
[4112] | 295 | !! Best estimate |
---|
| 296 | istat = nf90_inq_varid(ncid,'best_estimate',dm2id) |
---|
| 297 | IF (istat == nf90_noerr) THEN |
---|
| 298 | ln_best = .TRUE. |
---|
| 299 | ENDIF |
---|
| 300 | !! nrt_analysis |
---|
| 301 | istat = nf90_inq_varid(ncid,'nrt_analysis',dm1id) |
---|
| 302 | IF (istat == nf90_noerr) THEN |
---|
| 303 | ln_init = .TRUE. |
---|
| 304 | ENDIF |
---|
| 305 | !! Mean Dynamic Topography |
---|
| 306 | istat = nf90_inq_varid(ncid,'mdt_reference',mdtid) |
---|
| 307 | IF (istat == nf90_noerr) THEN |
---|
| 308 | ln_mdt = .TRUE. |
---|
| 309 | ENDIF |
---|
| 310 | !! Altimeter bias |
---|
| 311 | istat = nf90_inq_varid(ncid,'altimeter_bias',altid) |
---|
| 312 | IF (istat == nf90_noerr) THEN |
---|
| 313 | ln_altbias = .TRUE. |
---|
| 314 | ENDIF |
---|
| 315 | END IF |
---|
[4124] | 316 | WRITE(*,*) TRIM(cdinfile(ia)), " contains ", sobs, " observations" |
---|
| 317 | WRITE(*,*) TRIM(cdinfile(ia)), " contains ", sdeps, " depths" |
---|
| 318 | WRITE(*,*) TRIM(cdinfile(ia)), " contains ", nfcst, " forecasts" |
---|
| 319 | WRITE(*,*) TRIM(cdinfile(ia)), " contains ", nvars, " vars" |
---|
[4112] | 320 | !! Read Variables |
---|
| 321 | IF (sobs /= 0) THEN |
---|
| 322 | !! Get Variable ids |
---|
| 323 | CALL chkerr(nf90_inq_varid(ncid,'leadtime', fdvid) ,cpname, __LINE__ ) |
---|
| 324 | CALL chkerr(nf90_inq_varid(ncid,'longitude', lonid) ,cpname, __LINE__ ) |
---|
| 325 | CALL chkerr(nf90_inq_varid(ncid,'latitude', latid) ,cpname, __LINE__ ) |
---|
| 326 | CALL chkerr(nf90_inq_varid(ncid,'depth', depid) ,cpname, __LINE__ ) |
---|
| 327 | CALL chkerr(nf90_inq_varid(ncid,'varname', varid) ,cpname, __LINE__ ) |
---|
| 328 | CALL chkerr(nf90_inq_varid(ncid,'unitname', unitid) ,cpname, __LINE__ ) |
---|
| 329 | CALL chkerr(nf90_inq_varid(ncid,'observation', obvid) ,cpname, __LINE__ ) |
---|
| 330 | CALL chkerr(nf90_inq_varid(ncid,'forecast', fcvid) ,cpname, __LINE__ ) |
---|
| 331 | CALL chkerr(nf90_inq_varid(ncid,'persistence', prvid) ,cpname, __LINE__ ) |
---|
| 332 | CALL chkerr(nf90_inq_varid(ncid,'climatology', clvid) ,cpname, __LINE__ ) |
---|
| 333 | CALL chkerr(nf90_inq_varid(ncid,'qc', qcvid) ,cpname, __LINE__ ) |
---|
| 334 | CALL chkerr(nf90_inq_varid(ncid,'juld', jdvid) ,cpname, __LINE__ ) |
---|
| 335 | CALL chkerr(nf90_inq_varid(ncid,'modeljuld', mjdid) ,cpname, __LINE__ ) |
---|
| 336 | CALL chkerr(nf90_inq_varid(ncid,'type', typid) ,cpname, __LINE__ ) |
---|
| 337 | CALL chkerr(nf90_inq_varid(ncid,'id', idvid) ,cpname, __LINE__ ) |
---|
| 338 | !! Get variable attributes |
---|
| 339 | CALL chkerr(nf90_get_att(ncid, fdvid, 'units', fcd_units) ,cpname, __LINE__ ) |
---|
| 340 | CALL chkerr(nf90_get_att(ncid, lonid, 'units', lon_units) ,cpname, __LINE__ ) |
---|
| 341 | CALL chkerr(nf90_get_att(ncid, latid, 'units', lat_units) ,cpname, __LINE__ ) |
---|
| 342 | CALL chkerr(nf90_get_att(ncid, depid, 'units', dep_units) ,cpname, __LINE__ ) |
---|
| 343 | CALL chkerr(nf90_get_att(ncid, jdvid, 'units', jul_units) ,cpname, __LINE__ ) |
---|
| 344 | CALL chkerr(nf90_get_att(ncid, mjdid, 'units', mjd_units) ,cpname, __LINE__ ) |
---|
| 345 | CALL chkerr(nf90_get_att(ncid, fcvid, 'comment', fcst_comment) ,cpname, __LINE__ ) |
---|
| 346 | CALL chkerr(nf90_get_att(ncid, prvid, 'comment', per_comment) ,cpname, __LINE__ ) |
---|
| 347 | CALL chkerr(nf90_get_att(ncid, clvid, 'comment', cli_comment) ,cpname, __LINE__ ) |
---|
| 348 | CALL chkerr(nf90_get_att(ncid, fdvid, 'comment', lead_comment) ,cpname, __LINE__ ) |
---|
| 349 | CALL chkerr(nf90_get_att(ncid, qcvid, 'comment', qc_comment) ,cpname, __LINE__ ) |
---|
| 350 | CALL chkerr(nf90_get_att(ncid, qcvid, 'flag_value', qc_flag_value) ,cpname, __LINE__ ) |
---|
| 351 | CALL chkerr(nf90_get_att(ncid, qcvid, 'flag_meaning', qc_flag_meaning) ,cpname, __LINE__ ) |
---|
| 352 | !! Optional variables |
---|
| 353 | IF (ln_best) THEN |
---|
| 354 | CALL chkerr(nf90_inq_varid(ncid,'best_estimate',dm2id) ,cpname, __LINE__ ) |
---|
| 355 | CALL chkerr(nf90_get_att(ncid, dm2id, 'comment', dm2_comment) ,cpname, __LINE__ ) |
---|
| 356 | ENDIF |
---|
| 357 | IF (ln_init) THEN |
---|
| 358 | CALL chkerr(nf90_inq_varid(ncid,'nrt_analysis', dm1id) ,cpname, __LINE__ ) |
---|
| 359 | CALL chkerr(nf90_get_att(ncid, dm1id, 'comment', dm1_comment) ,cpname, __LINE__ ) |
---|
| 360 | ENDIF |
---|
| 361 | IF (ln_mdt) THEN |
---|
| 362 | CALL chkerr(nf90_inq_varid(ncid,'mdt_reference', mdtid) ,cpname, __LINE__ ) |
---|
| 363 | ENDIF |
---|
| 364 | IF (ln_altbias) THEN |
---|
| 365 | CALL chkerr(nf90_inq_varid(ncid,'altimeter_bias', altid) ,cpname, __LINE__ ) |
---|
| 366 | ENDIF |
---|
| 367 | |
---|
| 368 | !! Allocate small arrays |
---|
| 369 | ALLOCATE( s_lam(sobs), s_phi(sobs), s_dep(sdeps, sobs), & |
---|
| 370 | & s3dob(sdeps, nvars, sobs), & !: observations |
---|
| 371 | & s3dmc(sdeps, nfcst, nvars, sobs), & !: model data |
---|
| 372 | & s3dpr(sdeps, nfcst, nvars, sobs), & !: persistence |
---|
| 373 | & s3dcl(sdeps, nvars, sobs), & !: climatology |
---|
| 374 | & s3dm2(sdeps, nvars, sobs), & !: best estimate |
---|
| 375 | & s3dm1(sdeps, nvars, sobs), & !: nrt_analysis |
---|
| 376 | & s3mdt(sdeps, nvars, sobs), & !: mdt |
---|
| 377 | & s3alt(sdeps, nvars, sobs), & !: altbias |
---|
| 378 | & s3dqc(sdeps, nvars, sobs), & !: QC |
---|
| 379 | & sjuld(sobs), stype( sobs), & |
---|
| 380 | & s_id(sobs) ) |
---|
| 381 | !! Fill with missing data value |
---|
| 382 | s3dmc(:,:,:,:) = 99999. |
---|
| 383 | s3dpr(:,:,:,:) = 99999. |
---|
| 384 | s3dob(:,:,:) = 99999. |
---|
| 385 | s3dcl(:,:,:) = 99999. |
---|
| 386 | s3dm2(:,:,:) = 99999. |
---|
| 387 | s3dm1(:,:,:) = 99999. |
---|
| 388 | s3mdt(:,:,:) = 99999. |
---|
| 389 | s3alt(:,:,:) = 99999. |
---|
| 390 | s3dqc(:,:,:) = NF90_FILL_SHORT |
---|
| 391 | |
---|
| 392 | !! Read variables into small arrays |
---|
| 393 | CALL chkerr( nf90_get_var(ncid, fdvid, fcday), cpname, __LINE__ ) |
---|
| 394 | CALL chkerr( nf90_get_var(ncid, lonid, s_lam), cpname, __LINE__ ) |
---|
| 395 | CALL chkerr( nf90_get_var(ncid, latid, s_phi), cpname, __LINE__ ) |
---|
| 396 | CALL chkerr( nf90_get_var(ncid, depid, s_dep), cpname, __LINE__ ) |
---|
| 397 | CALL chkerr( nf90_get_var(ncid, obvid, s3dob), cpname, __LINE__ ) |
---|
| 398 | CALL chkerr( nf90_get_var(ncid, fcvid, s3dmc), cpname, __LINE__ ) |
---|
| 399 | CALL chkerr( nf90_get_var(ncid, prvid, s3dpr), cpname, __LINE__ ) |
---|
| 400 | CALL chkerr( nf90_get_var(ncid, clvid, s3dcl), cpname, __LINE__ ) |
---|
| 401 | CALL chkerr( nf90_get_var(ncid, qcvid, s3dqc), cpname, __LINE__ ) |
---|
| 402 | CALL chkerr( nf90_get_var(ncid, jdvid, sjuld), cpname, __LINE__ ) |
---|
| 403 | CALL chkerr( nf90_get_var(ncid, mjdid, modjd), cpname, __LINE__ ) |
---|
| 404 | CALL chkerr( nf90_get_var(ncid, typid, stype), cpname, __LINE__ ) |
---|
| 405 | CALL chkerr( nf90_get_var(ncid, idvid, s_id), cpname, __LINE__ ) |
---|
| 406 | !! Read unitname and varname into global arrays |
---|
| 407 | CALL chkerr( nf90_get_var(ncid, varid, gvnam), cpname, __LINE__ ) |
---|
| 408 | CALL chkerr( nf90_get_var(ncid, unitid,gunit), cpname, __LINE__ ) |
---|
| 409 | !! Optional variables read |
---|
| 410 | IF (ln_best) THEN |
---|
| 411 | CALL chkerr( nf90_get_var(ncid, dm2id, s3dm2), cpname, __LINE__ ) |
---|
| 412 | ENDIF |
---|
| 413 | IF (ln_init) THEN |
---|
| 414 | CALL chkerr( nf90_get_var(ncid, dm1id, s3dm1), cpname, __LINE__ ) |
---|
| 415 | ENDIF |
---|
| 416 | IF (ln_mdt) THEN |
---|
| 417 | CALL chkerr( nf90_get_var(ncid, mdtid, s3mdt), cpname, __LINE__ ) |
---|
| 418 | ENDIF |
---|
| 419 | IF (ln_altbias) THEN |
---|
| 420 | CALL chkerr( nf90_get_var(ncid, altid, s3alt), cpname, __LINE__ ) |
---|
| 421 | ENDIF |
---|
| 422 | |
---|
| 423 | !! Fill Global arrays |
---|
| 424 | ! increment numobs indices |
---|
| 425 | l_dex = u_dex + 1 |
---|
| 426 | u_dex = l_dex + sobs -1 |
---|
| 427 | |
---|
| 428 | g_lam(l_dex:u_dex) = s_lam(:) |
---|
| 429 | g_phi(l_dex:u_dex) = s_phi(:) |
---|
| 430 | g_dep(1:sdeps, l_dex:u_dex) = s_dep(1:sdeps,:) |
---|
| 431 | g3dob(1:sdeps,1:nvars,l_dex:u_dex) = s3dob(1:sdeps,1:nvars,:) |
---|
| 432 | g3dmc(1:sdeps,1:nfcst,1:nvars,l_dex:u_dex) = s3dmc(1:sdeps,1:nfcst,1:nvars,:) |
---|
| 433 | g3dpr(1:sdeps,1:nfcst,1:nvars,l_dex:u_dex) = s3dpr(1:sdeps,1:nfcst,1:nvars,:) |
---|
| 434 | g3dcl(1:sdeps,1:nvars,l_dex:u_dex) = s3dcl(1:sdeps,1:nvars,:) |
---|
| 435 | g3dm2(1:sdeps,1:nvars,l_dex:u_dex) = s3dm2(1:sdeps,1:nvars,:) |
---|
| 436 | g3dm1(1:sdeps,1:nvars,l_dex:u_dex) = s3dm1(1:sdeps,1:nvars,:) |
---|
| 437 | g3mdt(1:sdeps,1:nvars,l_dex:u_dex) = s3mdt(1:sdeps,1:nvars,:) |
---|
| 438 | g3alt(1:sdeps,1:nvars,l_dex:u_dex) = s3alt(1:sdeps,1:nvars,:) |
---|
| 439 | g3dqc(1:sdeps,1:nvars,l_dex:u_dex) = s3dqc(1:sdeps,1:nvars,:) |
---|
| 440 | gjuld(l_dex:u_dex) = sjuld(:) |
---|
| 441 | gtype(l_dex:u_dex) = stype(:) |
---|
| 442 | g_id(l_dex:u_dex) = s_id(:) |
---|
| 443 | |
---|
| 444 | !! Deallocate small array |
---|
| 445 | DEALLOCATE( s_lam, s_phi, s_dep, s3dob, s3dmc, s3dpr, s3dcl, s3dqc, s3dm2, s3dm1, s3mdt, s3alt, sjuld, stype, s_id) |
---|
| 446 | ENDIF ! sobs |
---|
| 447 | !! Close Netcdf file |
---|
| 448 | CALL chkerr( nf90_close(ncid), cpname, __LINE__ ) |
---|
| 449 | END IF ! istat |
---|
| 450 | END DO |
---|
| 451 | |
---|
| 452 | !! Create Output file |
---|
| 453 | IF (ln_cre) THEN |
---|
[4124] | 454 | WRITE(*,*) 'Create the output file, ',trim(cdoutfile) |
---|
| 455 | CALL chkerr( nf90_create(trim(cdoutfile),nf90_clobber,ncid), cpname, __LINE__ ) |
---|
[4112] | 456 | !! Put Global Attributes |
---|
| 457 | CALL date_format(dat_str) |
---|
| 458 | CALL chkerr( nf90_put_att(ncid, nf90_global,'title', trim(nam_str)),cpname, __LINE__) |
---|
| 459 | CALL chkerr( nf90_put_att(ncid, nf90_global,'version', trim(version)),cpname, __LINE__) |
---|
| 460 | CALL chkerr( nf90_put_att(ncid, nf90_global,'creation_date', trim(dat_str)),cpname, __LINE__) |
---|
| 461 | CALL chkerr( nf90_put_att(ncid, nf90_global,'contact', trim(contact)),cpname, __LINE__) |
---|
| 462 | CALL chkerr( nf90_put_att(ncid, nf90_global,'obs_type', trim(obs_str)),cpname, __LINE__) |
---|
| 463 | CALL chkerr( nf90_put_att(ncid, nf90_global,'system', trim(sys_str)),cpname, __LINE__) |
---|
| 464 | CALL chkerr( nf90_put_att(ncid, nf90_global,'configuration', trim(cfg_str)),cpname, __LINE__) |
---|
| 465 | CALL chkerr( nf90_put_att(ncid, nf90_global,'institution', trim(ins_str)),cpname, __LINE__) |
---|
| 466 | CALL chkerr( nf90_put_att(ncid, nf90_global,'validity_time', trim(val_str)),cpname, __LINE__) |
---|
[4128] | 467 | CALL chkerr( nf90_put_att(ncid, nf90_global,'best_estimate_description', & |
---|
| 468 | & 'analysis produced 2 days behind real time'),cpname, __LINE__) |
---|
[4112] | 469 | CALL chkerr( nf90_put_att(ncid, nf90_global,'time_interp', 'daily average fields'),cpname, __LINE__) |
---|
| 470 | WRITE(*,*) 'Succesfully put global attributes ' |
---|
| 471 | |
---|
| 472 | !! Define Dimensions |
---|
| 473 | CALL chkerr( nf90_def_dim(ncid, 'numdeps', ndeps, dpdim) ,cpname, __LINE__ ) |
---|
| 474 | CALL chkerr( nf90_def_dim(ncid, 'numfcsts', nfcst, fcdim) ,cpname, __LINE__ ) |
---|
| 475 | CALL chkerr( nf90_def_dim(ncid, 'numvars', nvars, vrdim) ,cpname, __LINE__ ) |
---|
| 476 | CALL chkerr( nf90_def_dim(ncid, 'numobs', nobs, obdim) ,cpname, __LINE__ ) |
---|
| 477 | CALL chkerr( nf90_def_dim(ncid, 'string_length8', nstr, stdim) ,cpname, __LINE__ ) |
---|
| 478 | CALL chkerr( nf90_def_dim(ncid, 'string_length128', n128, sxdim) ,cpname, __LINE__ ) |
---|
| 479 | WRITE(*,*) 'Succesfully defined dimensions' |
---|
| 480 | |
---|
| 481 | !! Define possible dimension permutations |
---|
| 482 | ! 2d |
---|
| 483 | dim2a(:) = (/ dpdim, obdim /) !: (/ ndeps, nobs /) |
---|
| 484 | dim2b(:) = (/ stdim, obdim /) !: (/ nstr, nobs /) |
---|
| 485 | dim2c(:) = (/ stdim, vrdim /) !: (/ nstr, nvars /) |
---|
| 486 | dim2d(:) = (/ sxdim, obdim /) !: (/ nstr, nobs /) |
---|
| 487 | ! 3d |
---|
| 488 | dim3a(:) = (/ dpdim, vrdim, obdim/) !: (/ ndeps, nvars, nobs /) |
---|
| 489 | ! 4d |
---|
| 490 | dim4a(:) = (/ dpdim, fcdim, vrdim, obdim /) !: (/ ndeps, nfcst, nvars, nobs /) |
---|
| 491 | |
---|
| 492 | |
---|
| 493 | !! Create the variables |
---|
| 494 | ! Forecast day |
---|
| 495 | CALL chkerr( nf90_def_var(ncid, 'leadtime', nf90_double, fcdim, fdvid) ,cpname, __LINE__ ) |
---|
| 496 | CALL chkerr( nf90_put_att(ncid, fdvid, 'long_name', 'Model forecast day offset') ,cpname, __LINE__ ) |
---|
| 497 | CALL chkerr( nf90_put_att(ncid, fdvid, 'units', trim(fcd_units)) ,cpname, __LINE__ ) |
---|
| 498 | CALL chkerr( nf90_put_att(ncid, fdvid, 'comment', trim(lead_comment)) ,cpname, __LINE__ ) |
---|
| 499 | WRITE(*,*) 'leadtime created' |
---|
| 500 | ! longitude |
---|
| 501 | CALL chkerr( nf90_def_var(ncid, 'longitude', nf90_float, obdim, lonid) ,cpname, __LINE__ ) |
---|
| 502 | CALL chkerr( nf90_put_att(ncid, lonid, 'long_name', 'Longitudes') ,cpname, __LINE__ ) |
---|
| 503 | CALL chkerr( nf90_put_att(ncid, lonid, 'units', trim(lon_units)) ,cpname, __LINE__ ) |
---|
| 504 | WRITE(*,*) 'lon created' |
---|
| 505 | ! latitude |
---|
| 506 | CALL chkerr( nf90_def_var(ncid, 'latitude', nf90_float, obdim, latid) ,cpname, __LINE__ ) |
---|
| 507 | CALL chkerr( nf90_put_att(ncid, latid, 'long_name', 'Latitudes') ,cpname, __LINE__ ) |
---|
| 508 | CALL chkerr( nf90_put_att(ncid, latid, 'units', trim(lat_units)) ,cpname, __LINE__ ) |
---|
| 509 | WRITE(*,*) 'lat created' |
---|
| 510 | ! depth |
---|
| 511 | CALL chkerr( nf90_def_var(ncid, 'depth', nf90_float, dim2a, depid) ,cpname, __LINE__ ) |
---|
| 512 | CALL chkerr( nf90_put_att(ncid, depid, 'long_name', 'Depths') ,cpname, __LINE__ ) |
---|
| 513 | CALL chkerr( nf90_put_att(ncid, depid, 'units', trim(dep_units)) ,cpname, __LINE__ ) |
---|
| 514 | CALL chkerr( nf90_put_att(ncid, depid, '_FillValue',obfillflt) ,cpname, __LINE__ ) |
---|
| 515 | WRITE(*,*) 'dep created' |
---|
| 516 | ! varname |
---|
| 517 | CALL chkerr( nf90_def_var(ncid, 'varname', nf90_char, dim2c, varid) ,cpname, __LINE__ ) |
---|
| 518 | CALL chkerr( nf90_put_att(ncid, varid, 'long_name', 'Variable name') ,cpname, __LINE__ ) |
---|
| 519 | WRITE(*,*) 'varname created' |
---|
| 520 | ! unitname |
---|
| 521 | CALL chkerr( nf90_def_var(ncid, 'unitname', nf90_char, dim2c, unitid) ,cpname, __LINE__ ) |
---|
| 522 | CALL chkerr( nf90_put_att(ncid, unitid, 'long_name', 'Unit name') ,cpname, __LINE__ ) |
---|
| 523 | WRITE(*,*) 'unitname created' |
---|
| 524 | ! obs |
---|
| 525 | CALL chkerr( nf90_def_var(ncid, 'observation', nf90_float, dim3a, obvid) ,cpname, __LINE__ ) |
---|
| 526 | CALL chkerr( nf90_put_att(ncid, obvid, '_FillValue',obfillflt) ,cpname, __LINE__ ) |
---|
| 527 | CALL chkerr( nf90_put_att(ncid, obvid, 'long_name', 'Observation value') ,cpname, __LINE__ ) |
---|
| 528 | WRITE(*,*) 'obs created' |
---|
| 529 | ! forecast |
---|
| 530 | CALL chkerr( nf90_def_var(ncid, 'forecast', nf90_float, dim4a, fcvid) ,cpname, __LINE__ ) |
---|
| 531 | CALL chkerr( nf90_put_att(ncid, fcvid, '_FillValue',obfillflt) ,cpname, __LINE__ ) |
---|
| 532 | CALL chkerr( nf90_put_att(ncid, fcvid, 'long_name', 'Model forecast counterpart of obs. value') ,cpname, __LINE__ ) |
---|
| 533 | CALL chkerr( nf90_put_att(ncid, fcvid, 'comment', trim(fcst_comment)) ,cpname, __LINE__ ) |
---|
| 534 | WRITE(*,*) 'forecast created' |
---|
| 535 | ! persistence |
---|
| 536 | CALL chkerr( nf90_def_var(ncid, 'persistence', nf90_float, dim4a, prvid) ,cpname, __LINE__ ) |
---|
| 537 | CALL chkerr( nf90_put_att(ncid, prvid, '_FillValue',obfillflt) ,cpname, __LINE__ ) |
---|
| 538 | CALL chkerr( nf90_put_att(ncid, prvid, 'long_name', 'Model persistence counterpart of obs. value'),cpname, __LINE__ ) |
---|
| 539 | CALL chkerr( nf90_put_att(ncid, prvid, 'comment', trim(per_comment)) ,cpname, __LINE__ ) |
---|
| 540 | WRITE(*,*) 'persistence created' |
---|
| 541 | ! clim |
---|
| 542 | CALL chkerr( nf90_def_var(ncid, 'climatology', nf90_float, dim3a, clvid) ,cpname, __LINE__ ) |
---|
| 543 | CALL chkerr( nf90_put_att(ncid, clvid, '_FillValue',obfillflt) ,cpname, __LINE__ ) |
---|
| 544 | CALL chkerr( nf90_put_att(ncid, clvid, 'long_name', 'Climatological value') ,cpname, __LINE__ ) |
---|
| 545 | CALL chkerr( nf90_put_att(ncid, clvid, 'comment', trim(cli_comment)) ,cpname, __LINE__ ) |
---|
| 546 | WRITE(*,*) 'clim created' |
---|
| 547 | IF (ln_best) THEN |
---|
| 548 | ! daym2 |
---|
| 549 | CALL chkerr( nf90_def_var(ncid, 'best_estimate', nf90_float, dim3a, dm2id) ,cpname, __LINE__ ) |
---|
| 550 | CALL chkerr( nf90_put_att(ncid, dm2id, '_FillValue',obfillflt) ,cpname, __LINE__ ) |
---|
| 551 | CALL chkerr( nf90_put_att(ncid, dm2id, 'long_name', 'Best estimate') ,cpname, __LINE__ ) |
---|
| 552 | CALL chkerr( nf90_put_att(ncid, dm2id, 'comment', trim(dm2_comment)) ,cpname, __LINE__ ) |
---|
| 553 | WRITE(*,*) 'daym2 created' |
---|
| 554 | ENDIF |
---|
| 555 | IF (ln_init) THEN |
---|
| 556 | ! daym1 |
---|
| 557 | CALL chkerr( nf90_def_var(ncid, 'nrt_analysis', nf90_float, dim3a, dm1id) ,cpname, __LINE__ ) |
---|
| 558 | CALL chkerr( nf90_put_att(ncid, dm1id, '_FillValue',obfillflt) ,cpname, __LINE__ ) |
---|
| 559 | CALL chkerr( nf90_put_att(ncid, dm1id, 'long_name', 'Near real time analysis') ,cpname, __LINE__ ) |
---|
| 560 | CALL chkerr( nf90_put_att(ncid, dm1id, 'comment', trim(dm1_comment)) ,cpname, __LINE__ ) |
---|
| 561 | WRITE(*,*) 'daym1 created' |
---|
| 562 | ENDIF |
---|
| 563 | IF (ln_mdt) THEN |
---|
| 564 | ! mdt |
---|
| 565 | CALL chkerr( nf90_def_var(ncid, 'mdt_reference', nf90_float, dim3a, mdtid) ,cpname, __LINE__ ) |
---|
| 566 | CALL chkerr( nf90_put_att(ncid, mdtid, '_FillValue',obfillflt) ,cpname, __LINE__ ) |
---|
| 567 | CALL chkerr( nf90_put_att(ncid, mdtid, 'long_name', 'Mean dynamic topography') ,cpname, __LINE__ ) |
---|
| 568 | WRITE(*,*) 'mdt created' |
---|
| 569 | ENDIF |
---|
| 570 | IF (ln_altbias) THEN |
---|
| 571 | ! altbias |
---|
| 572 | CALL chkerr( nf90_def_var(ncid, 'altimeter_bias', nf90_float, dim3a, altid) ,cpname, __LINE__ ) |
---|
| 573 | CALL chkerr( nf90_put_att(ncid, altid, '_FillValue',obfillflt) ,cpname, __LINE__ ) |
---|
| 574 | CALL chkerr( nf90_put_att(ncid, altid, 'long_name', 'Altimeter bias') ,cpname, __LINE__ ) |
---|
| 575 | WRITE(*,*) 'altbias created' |
---|
| 576 | ENDIF |
---|
| 577 | ! qc |
---|
| 578 | CALL chkerr( nf90_def_var(ncid, 'qc', nf90_short, dim3a, qcvid) ,cpname, __LINE__ ) |
---|
| 579 | CALL chkerr( nf90_put_att(ncid, qcvid, '_FillValue', NF90_FILL_SHORT) ,cpname, __LINE__ ) |
---|
| 580 | CALL chkerr( nf90_put_att(ncid, qcvid, 'long_name', 'Quality flags') ,cpname, __LINE__ ) |
---|
| 581 | CALL chkerr( nf90_put_att(ncid, qcvid, 'flag_value', qc_flag_value) ,cpname, __LINE__ ) |
---|
| 582 | CALL chkerr( nf90_put_att(ncid, qcvid, 'flag_meaning', qc_flag_meaning) ,cpname, __LINE__ ) |
---|
| 583 | CALL chkerr( nf90_put_att(ncid, qcvid, 'comment', qc_comment) ,cpname, __LINE__ ) |
---|
| 584 | WRITE(*,*) 'qc created' |
---|
| 585 | ! juld |
---|
| 586 | CALL chkerr( nf90_def_var(ncid, 'juld', nf90_double, obdim, jdvid) ,cpname, __LINE__ ) |
---|
| 587 | CALL chkerr( nf90_put_att(ncid, jdvid, '_FillValue',99999.) ,cpname, __LINE__ ) |
---|
| 588 | CALL chkerr( nf90_put_att(ncid, jdvid, 'long_name', 'Observation time in Julian days'),cpname, __LINE__ ) |
---|
| 589 | CALL chkerr( nf90_put_att(ncid, jdvid, 'units', trim(jul_units)) ,cpname, __LINE__ ) |
---|
| 590 | WRITE(*,*) 'juld created' |
---|
| 591 | ! modeljuld |
---|
| 592 | CALL chkerr( nf90_def_var(ncid, 'modeljuld', nf90_double, fcdim, mjdid) ,cpname, __LINE__ ) |
---|
| 593 | CALL chkerr( nf90_put_att(ncid, mjdid, 'long_name', 'Model field date in Julian days'),cpname, __LINE__ ) |
---|
| 594 | CALL chkerr( nf90_put_att(ncid, mjdid, 'units', trim(mjd_units)) ,cpname, __LINE__ ) |
---|
| 595 | WRITE(*,*) 'modeljuld created' |
---|
| 596 | ! type |
---|
| 597 | CALL chkerr( nf90_def_var(ncid, 'type', nf90_char, dim2d, typid) ,cpname, __LINE__ ) |
---|
| 598 | CALL chkerr( nf90_put_att(ncid, typid, 'long_name', 'Observation type') ,cpname, __LINE__ ) |
---|
| 599 | WRITE(*,*) 'type created' |
---|
| 600 | ! id |
---|
| 601 | CALL chkerr( nf90_def_var(ncid, 'id', nf90_char, dim2b, idvid) ,cpname, __LINE__ ) |
---|
| 602 | CALL chkerr( nf90_put_att(ncid, idvid, 'long_name', 'Observation id') ,cpname, __LINE__ ) |
---|
| 603 | WRITE(*,*) 'id created' |
---|
| 604 | ! Close Netcdf file |
---|
| 605 | CALL chkerr( nf90_close(ncid) ,cpname, __LINE__ ) |
---|
| 606 | !! Fill in the variables |
---|
[4124] | 607 | CALL chkerr( nf90_open(trim(cdoutfile),nf90_write,ncid), cpname, __LINE__ ) |
---|
| 608 | WRITE(*,*) 'Create the variables ',trim(cdoutfile) |
---|
[4112] | 609 | ! Forecast day |
---|
| 610 | CALL chkerr( nf90_inq_varid(ncid, 'leadtime', fdvid) ,cpname, __LINE__ ) |
---|
| 611 | CALL chkerr( nf90_put_var(ncid, fdvid, fcday) ,cpname, __LINE__ ) |
---|
| 612 | WRITE(*,*) 'forecast day put' |
---|
| 613 | ! longitude |
---|
| 614 | CALL chkerr( nf90_inq_varid(ncid, 'longitude', lonid) ,cpname, __LINE__ ) |
---|
| 615 | CALL chkerr( nf90_put_var(ncid, lonid, g_lam) ,cpname, __LINE__ ) |
---|
| 616 | WRITE(*,*) 'lon put' |
---|
| 617 | ! latitude |
---|
| 618 | CALL chkerr( nf90_inq_varid(ncid, 'latitude', latid) ,cpname, __LINE__ ) |
---|
| 619 | CALL chkerr( nf90_put_var(ncid, latid, g_phi) ,cpname, __LINE__ ) |
---|
| 620 | WRITE(*,*) 'lat put' |
---|
| 621 | ! depth |
---|
| 622 | CALL chkerr( nf90_inq_varid(ncid, 'depth',depid) ,cpname, __LINE__ ) |
---|
| 623 | CALL chkerr( nf90_put_var(ncid, depid, g_dep) ,cpname, __LINE__ ) |
---|
| 624 | WRITE(*,*) 'dep put' |
---|
| 625 | ! varname |
---|
| 626 | CALL chkerr( nf90_inq_varid(ncid, 'varname', varid) ,cpname, __LINE__ ) |
---|
| 627 | CALL chkerr( nf90_put_var(ncid, varid, gvnam,(/1,1/), (/nstr,nvars/) ) ,cpname, __LINE__ ) |
---|
| 628 | WRITE(*,*) 'var put' |
---|
| 629 | ! unitname |
---|
| 630 | CALL chkerr( nf90_inq_varid(ncid, 'unitname',unitid) ,cpname, __LINE__ ) |
---|
| 631 | CALL chkerr( nf90_put_var(ncid, unitid, gunit,(/1,1/),(/nstr,nvars/) ) ,cpname, __LINE__ ) |
---|
| 632 | WRITE(*,*) 'unitnam put' |
---|
| 633 | ! obs |
---|
| 634 | CALL chkerr( nf90_inq_varid(ncid, 'observation', obvid) ,cpname, __LINE__ ) |
---|
| 635 | CALL chkerr( nf90_put_var(ncid, obvid,g3dob ) ,cpname, __LINE__ ) |
---|
| 636 | WRITE(*,*) 'obs put' |
---|
| 637 | ! clim |
---|
| 638 | CALL chkerr( nf90_inq_varid(ncid, 'climatology', clvid) ,cpname, __LINE__ ) |
---|
| 639 | CALL chkerr( nf90_put_var(ncid, clvid,g3dcl ) ,cpname, __LINE__ ) |
---|
| 640 | WRITE(*,*) 'cli put' |
---|
| 641 | IF (ln_best) THEN |
---|
| 642 | ! daym2 |
---|
| 643 | CALL chkerr( nf90_inq_varid(ncid, 'best_estimate',dm2id) ,cpname, __LINE__ ) |
---|
| 644 | CALL chkerr( nf90_put_var(ncid, dm2id,g3dm2 ) ,cpname, __LINE__ ) |
---|
| 645 | WRITE(*,*) 'daym2 put' |
---|
| 646 | ENDIF |
---|
| 647 | IF (ln_init) THEN |
---|
| 648 | ! daym1 |
---|
| 649 | CALL chkerr( nf90_inq_varid(ncid, 'nrt_analysis',dm1id) ,cpname, __LINE__ ) |
---|
| 650 | CALL chkerr( nf90_put_var(ncid, dm1id,g3dm1 ) ,cpname, __LINE__ ) |
---|
| 651 | WRITE(*,*) 'daym1 put' |
---|
| 652 | ENDIF |
---|
| 653 | IF (ln_mdt) THEN |
---|
| 654 | ! mdt |
---|
| 655 | CALL chkerr( nf90_inq_varid(ncid, 'mdt_reference', mdtid) ,cpname, __LINE__ ) |
---|
| 656 | CALL chkerr( nf90_put_var(ncid, mdtid, g3mdt ) ,cpname, __LINE__ ) |
---|
| 657 | WRITE(*,*) 'mdt put' |
---|
| 658 | ENDIF |
---|
| 659 | IF (ln_altbias) THEN |
---|
| 660 | ! altbias |
---|
| 661 | CALL chkerr( nf90_inq_varid(ncid, 'altimeter_bias', altid) ,cpname, __LINE__ ) |
---|
| 662 | CALL chkerr( nf90_put_var(ncid, altid, g3alt ) ,cpname, __LINE__ ) |
---|
| 663 | WRITE(*,*) 'altbias put' |
---|
| 664 | ENDIF |
---|
| 665 | ! persistence |
---|
| 666 | CALL chkerr( nf90_inq_varid(ncid, 'persistence',prvid) ,cpname, __LINE__ ) |
---|
| 667 | CALL chkerr( nf90_put_var(ncid, prvid, g3dpr, (/1,1,1,1/) ,(/ ndeps,nfcst,nvars,nobs/) ) ,cpname, __LINE__ ) |
---|
| 668 | WRITE(*,*) 'per put' |
---|
| 669 | ! forecast |
---|
| 670 | CALL chkerr( nf90_inq_varid(ncid, 'forecast',fcvid) ,cpname, __LINE__ ) |
---|
| 671 | CALL chkerr( nf90_put_var(ncid, fcvid, g3dmc, (/1,1,1,1/), (/ ndeps,nfcst,nvars,nobs/) ) ,cpname, __LINE__ ) |
---|
| 672 | WRITE(*,*) 'fcst put' |
---|
| 673 | ! qc |
---|
| 674 | CALL chkerr( nf90_inq_varid(ncid, 'qc', qcvid) ,cpname, __LINE__ ) |
---|
| 675 | CALL chkerr( nf90_put_var(ncid, qcvid,g3dqc ) ,cpname, __LINE__ ) |
---|
| 676 | WRITE(*,*) 'qc put' |
---|
| 677 | ! juld |
---|
| 678 | CALL chkerr( nf90_inq_varid(ncid, 'juld',jdvid) ,cpname, __LINE__ ) |
---|
| 679 | CALL chkerr( nf90_put_var(ncid, jdvid, gjuld) ,cpname, __LINE__ ) |
---|
| 680 | WRITE(*,*) 'juld put' |
---|
| 681 | ! modeljuld |
---|
| 682 | CALL chkerr( nf90_inq_varid(ncid, 'modeljuld', mjdid) ,cpname, __LINE__ ) |
---|
| 683 | CALL chkerr( nf90_put_var(ncid, mjdid, modjd,(/1/),(/nfcst/)) ,cpname, __LINE__ ) |
---|
| 684 | WRITE(*,*) 'modjuld put' |
---|
| 685 | ! type |
---|
| 686 | CALL chkerr( nf90_inq_varid(ncid, 'type', typid) ,cpname, __LINE__ ) |
---|
| 687 | CALL chkerr( nf90_put_var(ncid, typid, gtype,(/1,1/) , (/n128,nobs/) ) ,cpname, __LINE__ ) |
---|
| 688 | WRITE(*,*) 'type put' |
---|
| 689 | ! id |
---|
| 690 | CALL chkerr( nf90_inq_varid(ncid, 'id', idvid) ,cpname, __LINE__ ) |
---|
| 691 | CALL chkerr( nf90_put_var(ncid, idvid, g_id,(/1,1/) , (/nstr,nobs/) ) ,cpname, __LINE__ ) |
---|
| 692 | WRITE(*,*) 'id put' |
---|
| 693 | ! Close netcdf file |
---|
| 694 | CALL chkerr( nf90_close(ncid), cpname, __LINE__ ) |
---|
| 695 | END IF ! ln_cre |
---|
| 696 | !! Deallocate Global arrays |
---|
| 697 | DEALLOCATE( g_lam, g_phi, g_dep, g3dob, g3dmc, g3dpr, g3dcl, g3dm2, g3dm1, g3mdt, g3alt, g3dqc, gjuld, gtype, g_id, gvnam, gunit) |
---|
| 698 | DEALLOCATE( fcday, modjd ) |
---|
| 699 | |
---|
[4124] | 700 | !! Deallocate input argument list |
---|
| 701 | DEALLOCATE(cdinfile) |
---|
[4112] | 702 | END PROGRAM c4comb |
---|