[2945] | 1 | PROGRAM fbstat |
---|
[3000] | 2 | !!--------------------------------------------------------------------- |
---|
| 3 | !! |
---|
| 4 | !! ** PROGRAM fbstat ** |
---|
| 5 | !! |
---|
| 6 | !! ** Purpose : Output feedback file summary info/statistics |
---|
| 7 | !! into a number of .dat files for different areas |
---|
| 8 | !! |
---|
| 9 | !! ** Method : Use of utilities from obs_fbm. |
---|
| 10 | !! |
---|
| 11 | !! ** Action : |
---|
| 12 | !! |
---|
| 13 | !! Usage: |
---|
[3002] | 14 | !! fbstat.exe [-nmlev] <filenames> |
---|
[3000] | 15 | !! Optional: |
---|
| 16 | !! namelist = namfbstat.in |
---|
| 17 | !! |
---|
| 18 | !! History : |
---|
| 19 | !! ! 2010 (K. Mogensen) Initial version |
---|
| 20 | !!---------------------------------------------------------------------- |
---|
[2945] | 21 | USE obs_fbm |
---|
| 22 | USE fbaccdata |
---|
| 23 | USE coords |
---|
| 24 | USE omonainfo |
---|
[3000] | 25 | USE fbstatncio |
---|
| 26 | USE proftools |
---|
[2945] | 27 | IMPLICIT NONE |
---|
| 28 | TYPE(obfbdata) :: fbdata |
---|
[3000] | 29 | CHARACTER(len=256) :: filename,outfilename |
---|
| 30 | INTEGER :: jfile,jbox,jlev,jfirst,jvar,jadd,ji,ja,jt,jboxl |
---|
[2945] | 31 | #ifndef NOIARGCPROTO |
---|
| 32 | INTEGER,EXTERNAL :: iargc |
---|
| 33 | #endif |
---|
| 34 | REAL,DIMENSION(:),ALLOCATABLE :: zlev |
---|
| 35 | INTEGER :: nmlev, nfiles |
---|
[3000] | 36 | LOGICAL :: lexists,lomona,ltext,lnetcdf,lzinp |
---|
[2945] | 37 | REAL, ALLOCATABLE, DIMENSION(:,:,:) :: zdat3d |
---|
| 38 | REAL, ALLOCATABLE, DIMENSION(:,:) :: zdat2d |
---|
| 39 | INTEGER,DIMENSION(1) :: itime |
---|
| 40 | INTEGER :: inidate,icurdate,loopno,ityp,iloopno |
---|
[3000] | 41 | INTEGER :: nvar,nadd,noberr,nbgerr |
---|
[2945] | 42 | CHARACTER(len=4) :: expver |
---|
[3000] | 43 | CHARACTER(len=20) :: cltyp |
---|
[2945] | 44 | CHARACTER(len=128) :: cdfmthead,cdfmtbody |
---|
| 45 | LOGICAL :: lnear,linner,linnerp,linnerini,lpassive,lhistogram,lfound |
---|
[3000] | 46 | LOGICAL :: lxyplot,lrmmean |
---|
| 47 | INTEGER :: nqc,nqco |
---|
| 48 | REAL :: rlspc,rlmax |
---|
| 49 | CHARACTER(len=ilenname), DIMENSION(:), ALLOCATABLE :: cname,caddname,& |
---|
| 50 | & cobename,cbgename |
---|
| 51 | INTEGER, PARAMETER :: nmaxareas = 20 |
---|
| 52 | CHARACTER(len=20), DIMENSION(nmaxareas) :: carea |
---|
| 53 | LOGICAL, DIMENSION(:), ALLOCATABLE :: lskipbox |
---|
| 54 | INTEGER, parameter :: maxtyp = 10 |
---|
| 55 | CHARACTER(len=ilentyp), DIMENSION(maxtyp) :: ctyp |
---|
| 56 | INTEGER :: ntyp,nboxuserl,ipdcst |
---|
| 57 | REAL :: mindcst |
---|
| 58 | NAMELIST/namfbstat/ltext,lomona,lnetcdf,nmlev,inidate,icurdate,loopno,& |
---|
| 59 | & expver,lnear,linner,lpassive,lhistogram,& |
---|
| 60 | & zhistmax,zhistmin,zhiststep,zcheck,carea,nmlev,& |
---|
| 61 | & nqc,nqco, & |
---|
| 62 | & rlspc,rlmax,ntyp,ctyp,& |
---|
| 63 | & lxyplot,zxymin,zxymax,zxystep,lzinp,lrmmean,mindcst |
---|
[2945] | 64 | |
---|
| 65 | ltext=.TRUE. |
---|
[3000] | 66 | lnetcdf=.TRUE. |
---|
[2945] | 67 | lomona=.FALSE. |
---|
| 68 | nmlev=31 |
---|
| 69 | inidate=19010101 |
---|
| 70 | icurdate=19010116 |
---|
[3000] | 71 | loopno=0 |
---|
[2945] | 72 | expver='test' |
---|
| 73 | lnear=.TRUE. |
---|
| 74 | linner=.FALSE. |
---|
| 75 | lpassive=.FALSE. |
---|
| 76 | lhistogram=.FALSE. |
---|
| 77 | zhistmin(:)=-10.0 |
---|
| 78 | zhistmax(:)=10.0 |
---|
| 79 | zhiststep(:)=0.1 |
---|
[3000] | 80 | zcheck(:)=1000.0 |
---|
[2945] | 81 | nqc=2 |
---|
[3000] | 82 | nqco=2 |
---|
| 83 | carea(:)='all' |
---|
| 84 | rlmax=5000.0 |
---|
| 85 | rlspc=-0.1 |
---|
| 86 | ntyp=1 |
---|
| 87 | ctyp(:)='all' |
---|
| 88 | lxyplot=.FALSE. |
---|
| 89 | zxymin(:)=-5.0 |
---|
| 90 | zxymax(:)=45.0 |
---|
| 91 | zxystep(:)=0.5 |
---|
| 92 | lzinp=.FALSE. |
---|
| 93 | lrmmean=.FALSE. |
---|
| 94 | mindcst=-1.0 |
---|
| 95 | |
---|
[2945] | 96 | INQUIRE(file='namfbstat.in',exist=lexists) |
---|
| 97 | IF (lexists) THEN |
---|
| 98 | OPEN(10,file='namfbstat.in') |
---|
| 99 | READ(10,namfbstat) |
---|
| 100 | CLOSE(10) |
---|
| 101 | WRITE(*,namfbstat) |
---|
| 102 | ENDIF |
---|
[3000] | 103 | mindcst=mindcst*1000.0 !From km to m. |
---|
[2945] | 104 | IF (iargc()==0) THEN |
---|
| 105 | WRITE(*,*)'Usage:' |
---|
| 106 | WRITE(*,*)'fbstat [-nmlev] <filenames>' |
---|
| 107 | CALL abort |
---|
| 108 | ENDIF |
---|
| 109 | jfirst=1 |
---|
| 110 | DO ji=1,2 |
---|
| 111 | CALL getarg(jfirst,filename) |
---|
| 112 | IF (filename=='-42') THEN |
---|
| 113 | nmlev=42 |
---|
| 114 | jfirst=jfirst+1 |
---|
| 115 | ELSEIF(filename=='-31') THEN |
---|
| 116 | nmlev=31 |
---|
| 117 | jfirst=jfirst+1 |
---|
| 118 | ELSEIF(filename=='-1') THEN |
---|
| 119 | nmlev=1 |
---|
| 120 | lnear=.TRUE. |
---|
| 121 | jfirst=jfirst+1 |
---|
| 122 | ELSEIF(filename=='-q') THEN |
---|
| 123 | jfirst=jfirst+1 |
---|
| 124 | CALL getarg(jfirst,filename) |
---|
| 125 | READ(filename,'(I4)')nqc |
---|
| 126 | IF ((nqc<0).OR.(nqc>4)) THEN |
---|
| 127 | WRITE(*,*)'Quality control option (-q) should be 1 to 4' |
---|
| 128 | CALL abort |
---|
| 129 | ENDIF |
---|
| 130 | jfirst=jfirst+1 |
---|
| 131 | ENDIF |
---|
| 132 | END DO |
---|
| 133 | nfiles=iargc() |
---|
[3000] | 134 | |
---|
| 135 | CALL coord_user_init('o') |
---|
| 136 | |
---|
| 137 | ALLOCATE(lskipbox(nboxuser)) |
---|
| 138 | lskipbox(:)=.FALSE. |
---|
| 139 | |
---|
| 140 | IF (carea(1)/='all') THEN |
---|
[2945] | 141 | IF (lomona) THEN |
---|
[3000] | 142 | WRITE(*,*)'For omona files carea(1) has to be all' |
---|
[2945] | 143 | CALL abort |
---|
| 144 | ENDIF |
---|
[3000] | 145 | lskipbox(:)=.TRUE. |
---|
| 146 | DO ji=1,nmaxareas |
---|
| 147 | IF (carea(ji)/='all') THEN |
---|
| 148 | lfound=.FALSE. |
---|
| 149 | DO jbox=1,nboxuser |
---|
| 150 | IF (TRIM(carea(ji))==TRIM(cl_boxes_user(jbox))) THEN |
---|
| 151 | lskipbox(jbox)=.FALSE. |
---|
| 152 | lfound=.TRUE. |
---|
| 153 | ENDIF |
---|
| 154 | ENDDO |
---|
| 155 | IF (.NOT.lfound) THEN |
---|
| 156 | WRITE(*,*)'Area ',TRIM(carea(ji)),' not found' |
---|
| 157 | CALL abort |
---|
| 158 | ENDIF |
---|
[2945] | 159 | ENDIF |
---|
| 160 | ENDDO |
---|
[3000] | 161 | nboxuserl=0 |
---|
| 162 | DO ji=1,nboxuser |
---|
| 163 | WRITE(*,*)'Area ',TRIM(cl_boxes_user(ji)),' is set to ',lskipbox(ji) |
---|
| 164 | IF (.NOT.lskipbox(ji)) nboxuserl=nboxuserl+1 |
---|
| 165 | ENDDO |
---|
| 166 | WRITE(*,*)'Total areas for statistics = ',nboxuserl |
---|
| 167 | IF (lomona.AND.(nboxuserl/=nboxuser)) THEN |
---|
| 168 | WRITE(*,*)'Omona files only possible if all areas' |
---|
[2945] | 169 | CALL abort |
---|
| 170 | ENDIF |
---|
| 171 | ELSE |
---|
[3000] | 172 | nboxuserl=nboxuser |
---|
[2945] | 173 | ENDIF |
---|
| 174 | |
---|
[3000] | 175 | IF (rlspc>0.0) THEN |
---|
| 176 | lnear=.TRUE. |
---|
| 177 | nmlev=rlmax/rlspc+1 |
---|
| 178 | ALLOCATE(zlev(nmlev)) |
---|
| 179 | DO ji=1,nmlev |
---|
| 180 | zlev(ji)=(ji-1)*rlspc |
---|
| 181 | ENDDO |
---|
[2945] | 182 | ELSE |
---|
[3000] | 183 | IF (.NOT.lnear) nmlev=nmlev-1 |
---|
| 184 | ALLOCATE(& |
---|
| 185 | & zlev(nmlev) & |
---|
| 186 | & ) |
---|
| 187 | IF(lnear) THEN |
---|
| 188 | CALL getlevs(nmlev,zlev) |
---|
| 189 | ELSE |
---|
| 190 | CALL getlevsmean(nmlev,zlev) |
---|
| 191 | ENDIF |
---|
[2945] | 192 | ENDIF |
---|
| 193 | |
---|
| 194 | DO jfile=jfirst, nfiles |
---|
| 195 | CALL getarg(jfile,filename) |
---|
| 196 | WRITE(*,*)'Handling file : ',TRIM(filename) |
---|
[3000] | 197 | CALL flush(6) |
---|
| 198 | IF (lzinp) THEN |
---|
| 199 | #if defined NOSYSTEM |
---|
| 200 | WRITE(*,*)'Compressed files need the system subroutine call' |
---|
| 201 | CALL abort |
---|
| 202 | #else |
---|
| 203 | CALL system('cp '//TRIM(filename)//' fbstat_tmp.nc.gz') |
---|
| 204 | CALL system('gzip -df fbstat_tmp.nc.gz') |
---|
| 205 | CALL read_obfbdata('fbstat_tmp.nc',fbdata) |
---|
| 206 | CALL system('rm -f fbstat_tmp.nc') |
---|
| 207 | #endif |
---|
| 208 | ELSE |
---|
| 209 | CALL read_obfbdata(TRIM(filename),fbdata) |
---|
| 210 | ENDIF |
---|
| 211 | CALL sealsfromargo( fbdata ) |
---|
[2945] | 212 | IF (jfile==jfirst) THEN |
---|
| 213 | nvar=fbdata%nvar |
---|
[3000] | 214 | nadd=0 |
---|
| 215 | DO ja= 1, fbdata%nadd |
---|
| 216 | IF (fbdata%caddname(ja)(1:2)=='Hx') nadd=nadd+1 |
---|
| 217 | ENDDO |
---|
| 218 | noberr=0 |
---|
| 219 | DO ja= 1, fbdata%nadd |
---|
| 220 | IF (fbdata%caddname(ja)(1:3)=='OBE') noberr=noberr+1 |
---|
| 221 | ENDDO |
---|
| 222 | nbgerr=0 |
---|
| 223 | DO ja= 1, fbdata%nadd |
---|
| 224 | IF (fbdata%caddname(ja)(1:3)=='BGE') nbgerr=nbgerr+1 |
---|
| 225 | ENDDO |
---|
[2945] | 226 | IF (lhistogram) THEN |
---|
| 227 | IF (nvar>maxvars) THEN |
---|
| 228 | WRITE(*,*)'fbstat.F90: Increase maxvars to ',nvar |
---|
| 229 | WRITE(*,*)'if you want histograms' |
---|
| 230 | CALL abort |
---|
| 231 | ENDIF |
---|
| 232 | DO jvar = 1, nvar |
---|
| 233 | hist(jvar)%npoints=(zhistmax(jvar)-zhistmin(jvar))& |
---|
| 234 | & /zhiststep(jvar)+1 |
---|
| 235 | WRITE(*,*)'Number of points in histogram = ',& |
---|
| 236 | & hist(jvar)%npoints |
---|
| 237 | WRITE(*,*)'Size of histogram array (elements) = ',& |
---|
[3000] | 238 | & hist(jvar)%npoints*nmlev*nboxuserl*nadd |
---|
[2945] | 239 | ALLOCATE(& |
---|
[3000] | 240 | & hist(jvar)%nhist(hist(jvar)%npoints,nmlev,nboxuserl,nadd,ntyp) & |
---|
[2945] | 241 | & ) |
---|
[3000] | 242 | hist(jvar)%nhist(:,:,:,:,:)=0 |
---|
[2945] | 243 | ENDDO |
---|
| 244 | ENDIF |
---|
[3000] | 245 | ipdcst=0 |
---|
| 246 | IF (mindcst>0) THEN |
---|
| 247 | DO ja= 1, fbdata%next |
---|
| 248 | IF (TRIM(fbdata%cextname(ja))=='DCST') THEN |
---|
| 249 | ipdcst=ja |
---|
| 250 | EXIT |
---|
| 251 | ENDIF |
---|
| 252 | ENDDO |
---|
| 253 | IF (ipdcst==0) THEN |
---|
| 254 | WRITE(*,*)'Distance to coast not found in file, but mindcst>0' |
---|
| 255 | WRITE(*,*)'Extra variables:' |
---|
| 256 | DO ja= 1, fbdata%next |
---|
| 257 | WRITE(*,*)ja,TRIM(fbdata%cextname(ja)) |
---|
| 258 | ENDDO |
---|
| 259 | CALL abort |
---|
| 260 | ENDIF |
---|
| 261 | ENDIF |
---|
| 262 | IF (lxyplot) THEN |
---|
| 263 | IF (nvar>maxvars) THEN |
---|
| 264 | WRITE(*,*)'fbstat.F90: Increase maxvars to ',nvar |
---|
| 265 | WRITE(*,*)'if you want xyplots' |
---|
| 266 | CALL abort |
---|
| 267 | ENDIF |
---|
| 268 | DO jvar = 1, nvar |
---|
| 269 | xy(jvar)%npoints=(zxymax(jvar)-zxymin(jvar))& |
---|
| 270 | & /zxystep(jvar)+1 |
---|
| 271 | WRITE(*,*)'Number of points in x and y for xyplots = ',& |
---|
| 272 | & xy(jvar)%npoints |
---|
| 273 | WRITE(*,*)'Size of xyplot array (elements) = ',& |
---|
| 274 | & xy(jvar)%npoints*xy(jvar)%npoints*nmlev*nboxuserl*nadd |
---|
| 275 | ALLOCATE(& |
---|
| 276 | & xy(jvar)%nxy(xy(jvar)%npoints,xy(jvar)%npoints,& |
---|
| 277 | & nmlev,nboxuserl,nadd,ntyp) & |
---|
| 278 | & ) |
---|
| 279 | xy(jvar)%nxy(:,:,:,:,:,:)=0 |
---|
| 280 | ENDDO |
---|
| 281 | ENDIF |
---|
[2945] | 282 | ALLOCATE(& |
---|
[3000] | 283 | & inum(nmlev,nboxuserl,nadd,nvar,ntyp), & |
---|
| 284 | & inumov(nmlev,nboxuserl,noberr,nvar,ntyp), & |
---|
| 285 | & inumbv(nmlev,nboxuserl,nbgerr,nvar,ntyp), & |
---|
| 286 | & inuma(nmlev,nboxuserl,nvar,ntyp), & |
---|
| 287 | & zbias(nmlev,nboxuserl,nadd,nvar,ntyp), & |
---|
| 288 | & zrms(nmlev,nboxuserl,nadd,nvar,ntyp), & |
---|
| 289 | & zsdev(nmlev,nboxuserl,nadd,nvar,ntyp), & |
---|
| 290 | & zomean(nmlev,nboxuserl,nadd,nvar,ntyp),& |
---|
| 291 | & zmmean(nmlev,nboxuserl,nadd,nvar,ntyp),& |
---|
| 292 | & zoemea(nmlev,nboxuserl,noberr,nvar,ntyp),& |
---|
| 293 | & zovmea(nmlev,nboxuserl,noberr,nvar,ntyp),& |
---|
| 294 | & zbemea(nmlev,nboxuserl,nbgerr,nvar,ntyp),& |
---|
| 295 | & zbvmea(nmlev,nboxuserl,nbgerr,nvar,ntyp),& |
---|
| 296 | & zoamean(nmlev,nboxuserl,nvar,ntyp), & |
---|
| 297 | & cname(nvar), & |
---|
| 298 | & caddname(nadd), & |
---|
| 299 | & cobename(noberr), & |
---|
| 300 | & cbgename(nbgerr) & |
---|
[2945] | 301 | & ) |
---|
| 302 | DO jvar = 1, nvar |
---|
| 303 | cname(jvar) = fbdata%cname(jvar) |
---|
| 304 | END DO |
---|
[3000] | 305 | jadd = 0 |
---|
| 306 | DO ja= 1, fbdata%nadd |
---|
| 307 | IF (fbdata%caddname(ja)(1:2)=='Hx') THEN |
---|
| 308 | jadd=jadd+1 |
---|
| 309 | caddname(jadd) = fbdata%caddname(ja) |
---|
| 310 | ENDIF |
---|
[2945] | 311 | END DO |
---|
[3000] | 312 | jadd = 0 |
---|
| 313 | DO ja= 1, fbdata%nadd |
---|
| 314 | IF (fbdata%caddname(ja)(1:3)=='OBE') THEN |
---|
| 315 | jadd=jadd+1 |
---|
| 316 | cobename(jadd) = fbdata%caddname(ja) |
---|
| 317 | ENDIF |
---|
| 318 | END DO |
---|
| 319 | jadd = 0 |
---|
| 320 | DO ja= 1, fbdata%nadd |
---|
| 321 | IF (fbdata%caddname(ja)(1:3)=='BGE') THEN |
---|
| 322 | jadd=jadd+1 |
---|
| 323 | cbgename(jadd) = fbdata%caddname(ja) |
---|
| 324 | ENDIF |
---|
| 325 | END DO |
---|
| 326 | IF (nadd>0) THEN |
---|
| 327 | inum(:,:,:,:,:)=0 |
---|
| 328 | zbias(:,:,:,:,:)=0.0 |
---|
| 329 | zrms(:,:,:,:,:)=0.0 |
---|
| 330 | zsdev(:,:,:,:,:)=0.0 |
---|
| 331 | zomean(:,:,:,:,:)=0.0 |
---|
| 332 | zmmean(:,:,:,:,:)=0.0 |
---|
| 333 | ENDIF |
---|
| 334 | IF (noberr>0) THEN |
---|
| 335 | inumov(:,:,:,:,:)=0 |
---|
| 336 | zoemea(:,:,:,:,:)=0 |
---|
| 337 | zovmea(:,:,:,:,:)=0 |
---|
| 338 | ENDIF |
---|
| 339 | IF (nbgerr>0) THEN |
---|
| 340 | inumbv(:,:,:,:,:)=0 |
---|
| 341 | zbemea(:,:,:,:,:)=0 |
---|
| 342 | zbvmea(:,:,:,:,:)=0 |
---|
| 343 | ENDIF |
---|
| 344 | inuma(:,:,:,:)=0 |
---|
| 345 | zoamean(:,:,:,:)=0.0 |
---|
[2945] | 346 | ELSE |
---|
| 347 | IF (fbdata%nvar/=nvar) THEN |
---|
| 348 | WRITE(*,*)'Different number of nvar ',fbdata%nvar,' in ',& |
---|
| 349 | & TRIM(filename) |
---|
| 350 | CALL abort |
---|
| 351 | ENDIF |
---|
[3000] | 352 | jadd = 0 |
---|
| 353 | DO ja= 1, fbdata%nadd |
---|
| 354 | IF (fbdata%caddname(ja)(1:2)=='Hx') THEN |
---|
| 355 | jadd=jadd+1 |
---|
| 356 | ENDIF |
---|
| 357 | END DO |
---|
| 358 | IF (jadd/=nadd) THEN |
---|
| 359 | WRITE(*,*)'Different number of nadd ',jadd,' in ',& |
---|
[2945] | 360 | & TRIM(filename) |
---|
| 361 | CALL abort |
---|
| 362 | ENDIF |
---|
[3000] | 363 | jadd = 0 |
---|
| 364 | DO ja= 1, fbdata%nadd |
---|
| 365 | IF (fbdata%caddname(ja)(1:3)=='OBE') THEN |
---|
| 366 | jadd=jadd+1 |
---|
| 367 | ENDIF |
---|
| 368 | END DO |
---|
| 369 | IF (jadd/=noberr) THEN |
---|
| 370 | WRITE(*,*)'Different number of noberr ',jadd,' in ',& |
---|
| 371 | & TRIM(filename) |
---|
| 372 | CALL abort |
---|
| 373 | ENDIF |
---|
| 374 | jadd = 0 |
---|
| 375 | DO ja= 1, fbdata%nadd |
---|
| 376 | IF (fbdata%caddname(ja)(1:3)=='BGE') THEN |
---|
| 377 | jadd=jadd+1 |
---|
| 378 | ENDIF |
---|
| 379 | END DO |
---|
| 380 | IF (jadd/=nbgerr) THEN |
---|
| 381 | WRITE(*,*)'Different number of nbgerr ',jadd,' in ',& |
---|
| 382 | & TRIM(filename) |
---|
| 383 | CALL abort |
---|
| 384 | ENDIF |
---|
| 385 | IF (ipdcst>0) THEN |
---|
| 386 | IF (ipdcst>fbdata%next) THEN |
---|
| 387 | WRITE(*,*)'Distrance to coast in file not compatible with first file' |
---|
| 388 | CALL abort |
---|
| 389 | ENDIF |
---|
| 390 | IF (TRIM(fbdata%cextname(ipdcst))/='DCST') THEN |
---|
| 391 | WRITE(*,*)'Distrance to coast in file not compatible with first file' |
---|
| 392 | CALL abort |
---|
| 393 | ENDIF |
---|
| 394 | ENDIF |
---|
[2945] | 395 | ENDIF |
---|
[3000] | 396 | IF (lrmmean) THEN |
---|
| 397 | CALL fb_rmmean(fbdata) |
---|
| 398 | ENDIF |
---|
| 399 | CALL fb_stat(fbdata,lskipbox,nmlev,zlev,lnear,nqc,nqco,& |
---|
| 400 | & lhistogram,lxyplot,ntyp,ctyp,ipdcst,mindcst) |
---|
[2945] | 401 | CALL dealloc_obfbdata(fbdata) |
---|
| 402 | ENDDO |
---|
| 403 | |
---|
[3000] | 404 | DO jt=1,ntyp |
---|
| 405 | DO jvar=1,nvar |
---|
| 406 | DO jadd=1,nadd |
---|
| 407 | jboxl=0 |
---|
| 408 | DO jbox=1,nboxuser |
---|
| 409 | IF (lskipbox(jbox)) CYCLE |
---|
| 410 | jboxl=jboxl+1 |
---|
| 411 | DO jlev = 1, nmlev |
---|
| 412 | IF ( inum(jlev,jboxl,jadd,jvar,jt) > 0 ) THEN |
---|
| 413 | zbias(jlev,jboxl,jadd,jvar,jt) = & |
---|
| 414 | & zbias(jlev,jboxl,jadd,jvar,jt)/inum(jlev,jboxl,jadd,jvar,jt) |
---|
| 415 | zrms(jlev,jboxl,jadd,jvar,jt) = & |
---|
| 416 | & SQRT(zrms(jlev,jboxl,jadd,jvar,jt)/inum(jlev,jboxl,jadd,jvar,jt)) |
---|
| 417 | zsdev(jlev,jboxl,jadd,jvar,jt) = & |
---|
| 418 | & SQRT(MAX(zrms(jlev,jboxl,jadd,jvar,jt)**2-zbias(jlev,jboxl,jadd,jvar,jt)**2,0.0)) |
---|
| 419 | zomean(jlev,jboxl,jadd,jvar,jt) = & |
---|
| 420 | & zomean(jlev,jboxl,jadd,jvar,jt)/inum(jlev,jboxl,jadd,jvar,jt) |
---|
| 421 | zmmean(jlev,jboxl,jadd,jvar,jt) = & |
---|
| 422 | & zmmean(jlev,jboxl,jadd,jvar,jt)/inum(jlev,jboxl,jadd,jvar,jt) |
---|
| 423 | ELSE |
---|
| 424 | zbias(jlev,jboxl,jadd,jvar,jt) = fbrmdi |
---|
| 425 | zrms(jlev,jboxl,jadd,jvar,jt) = fbrmdi |
---|
| 426 | zsdev(jlev,jboxl,jadd,jvar,jt) = fbrmdi |
---|
| 427 | zomean(jlev,jboxl,jadd,jvar,jt) = fbrmdi |
---|
| 428 | zmmean(jlev,jboxl,jadd,jvar,jt) = fbrmdi |
---|
| 429 | ENDIF |
---|
| 430 | ENDDO |
---|
| 431 | ENDDO |
---|
| 432 | ENDDO |
---|
| 433 | DO jadd=1,noberr |
---|
| 434 | jboxl=0 |
---|
| 435 | DO jbox=1,nboxuser |
---|
| 436 | IF (lskipbox(jbox)) CYCLE |
---|
| 437 | jboxl=jboxl+1 |
---|
| 438 | DO jlev = 1, nmlev |
---|
| 439 | IF ( inumov(jlev,jboxl,jadd,jvar,jt) > 0 ) THEN |
---|
| 440 | zoemea(jlev,jboxl,jadd,jvar,jt) = & |
---|
| 441 | & zoemea(jlev,jboxl,jadd,jvar,jt)/inumov(jlev,jboxl,jadd,jvar,jt) |
---|
| 442 | zovmea(jlev,jboxl,jadd,jvar,jt) = & |
---|
| 443 | & zovmea(jlev,jboxl,jadd,jvar,jt)/inumov(jlev,jboxl,jadd,jvar,jt) |
---|
| 444 | ELSE |
---|
| 445 | zoemea(jlev,jboxl,jadd,jvar,jt) = fbrmdi |
---|
| 446 | zovmea(jlev,jboxl,jadd,jvar,jt) = fbrmdi |
---|
| 447 | ENDIF |
---|
| 448 | ENDDO |
---|
| 449 | ENDDO |
---|
| 450 | ENDDO |
---|
| 451 | DO jadd=1,nbgerr |
---|
| 452 | jboxl=0 |
---|
| 453 | DO jbox=1,nboxuser |
---|
| 454 | IF (lskipbox(jbox)) CYCLE |
---|
| 455 | jboxl=jboxl+1 |
---|
| 456 | DO jlev = 1, nmlev |
---|
| 457 | IF ( inumbv(jlev,jboxl,jadd,jvar,jt) > 0 ) THEN |
---|
| 458 | zbemea(jlev,jboxl,jadd,jvar,jt) = & |
---|
| 459 | & zbemea(jlev,jboxl,jadd,jvar,jt)/inumbv(jlev,jboxl,jadd,jvar,jt) |
---|
| 460 | zbvmea(jlev,jboxl,jadd,jvar,jt) = & |
---|
| 461 | & zbvmea(jlev,jboxl,jadd,jvar,jt)/inumbv(jlev,jboxl,jadd,jvar,jt) |
---|
| 462 | ELSE |
---|
| 463 | zbemea(jlev,jboxl,jadd,jvar,jt) = fbrmdi |
---|
| 464 | zbvmea(jlev,jboxl,jadd,jvar,jt) = fbrmdi |
---|
| 465 | ENDIF |
---|
| 466 | ENDDO |
---|
| 467 | ENDDO |
---|
| 468 | ENDDO |
---|
| 469 | ENDDO |
---|
| 470 | ENDDO |
---|
| 471 | DO jt=1,ntyp |
---|
| 472 | DO jvar=1,nvar |
---|
| 473 | jboxl=0 |
---|
| 474 | DO jbox=1,nboxuser |
---|
| 475 | IF (lskipbox(jbox)) CYCLE |
---|
| 476 | jboxl=jboxl+1 |
---|
[2945] | 477 | DO jlev = 1, nmlev |
---|
[3000] | 478 | IF ( inuma(jlev,jboxl,jvar,jt) > 0 ) THEN |
---|
| 479 | zoamean(jlev,jboxl,jvar,jt) = & |
---|
| 480 | & zoamean(jlev,jboxl,jvar,jt)/inuma(jlev,jboxl,jvar,jt) |
---|
[2945] | 481 | ELSE |
---|
[3000] | 482 | zoamean(jlev,jboxl,jvar,jt) = fbrmdi |
---|
[2945] | 483 | ENDIF |
---|
| 484 | ENDDO |
---|
| 485 | ENDDO |
---|
| 486 | ENDDO |
---|
| 487 | ENDDO |
---|
| 488 | |
---|
| 489 | IF (ltext) THEN |
---|
[3000] | 490 | |
---|
| 491 | DO jt=1,ntyp |
---|
| 492 | DO jvar=1,nvar |
---|
| 493 | DO jadd=1,nadd |
---|
| 494 | jboxl=0 |
---|
| 495 | DO jbox=1,nboxuser |
---|
| 496 | IF (lskipbox(jbox)) CYCLE |
---|
| 497 | jboxl=jboxl+1 |
---|
| 498 | WRITE(filename,'(7A)')TRIM(cname(jvar)),& |
---|
| 499 | & TRIM(caddname(jadd)),'_',& |
---|
| 500 | & TRIM(cl_boxes_user(jbox)),'_',& |
---|
| 501 | & TRIM(ADJUSTL(ctyp(jt))),'.dat' |
---|
| 502 | OPEN(10,file=TRIM(filename)) |
---|
| 503 | DO jlev = 1, nmlev |
---|
| 504 | WRITE(10,'(F16.7,2I12,5F17.10)') zlev(jlev), & |
---|
| 505 | & jlev, inum(jlev,jboxl,jadd,jvar,jt), & |
---|
| 506 | & zbias(jlev,jboxl,jadd,jvar,jt), & |
---|
| 507 | & zrms(jlev,jboxl,jadd,jvar,jt), & |
---|
| 508 | & zsdev(jlev,jboxl,jadd,jvar,jt), & |
---|
| 509 | & zomean(jlev,jboxl,jadd,jvar,jt), & |
---|
| 510 | & zmmean(jlev,jboxl,jadd,jvar,jt) |
---|
| 511 | ENDDO |
---|
| 512 | CLOSE(10) |
---|
| 513 | ENDDO |
---|
| 514 | ENDDO |
---|
| 515 | DO jadd=1,noberr |
---|
| 516 | jboxl=0 |
---|
| 517 | DO jbox=1,nboxuser |
---|
| 518 | IF (lskipbox(jbox)) CYCLE |
---|
| 519 | jboxl=jboxl+1 |
---|
| 520 | WRITE(filename,'(7A)')TRIM(cname(jvar)),& |
---|
| 521 | & TRIM(cobename(jadd)),'_',& |
---|
| 522 | & TRIM(cl_boxes_user(jbox)),'_',& |
---|
| 523 | & TRIM(ADJUSTL(ctyp(jt))),'.dat' |
---|
| 524 | OPEN(10,file=TRIM(filename)) |
---|
| 525 | DO jlev = 1, nmlev |
---|
| 526 | WRITE(10,'(F16.7,2I12,5F17.10)') zlev(jlev), & |
---|
| 527 | & jlev, inumov(jlev,jboxl,jadd,jvar,jt), & |
---|
| 528 | & zoemea(jlev,jboxl,jadd,jvar,jt), & |
---|
| 529 | & zovmea(jlev,jboxl,jadd,jvar,jt) |
---|
| 530 | ENDDO |
---|
| 531 | CLOSE(10) |
---|
| 532 | ENDDO |
---|
| 533 | ENDDO |
---|
| 534 | DO jadd=1,nbgerr |
---|
| 535 | jboxl=0 |
---|
| 536 | DO jbox=1,nboxuser |
---|
| 537 | IF (lskipbox(jbox)) CYCLE |
---|
| 538 | jboxl=jboxl+1 |
---|
| 539 | WRITE(filename,'(7A)')TRIM(cname(jvar)),& |
---|
| 540 | & TRIM(cbgename(jadd)),'_',& |
---|
| 541 | & TRIM(cl_boxes_user(jbox)),'_',& |
---|
| 542 | & TRIM(ADJUSTL(ctyp(jt))),'.dat' |
---|
| 543 | OPEN(10,file=TRIM(filename)) |
---|
| 544 | DO jlev = 1, nmlev |
---|
| 545 | WRITE(10,'(F16.7,2I12,5F17.10)') zlev(jlev), & |
---|
| 546 | & jlev, inumbv(jlev,jboxl,jadd,jvar,jt), & |
---|
| 547 | & zbemea(jlev,jboxl,jadd,jvar,jt), & |
---|
| 548 | & zbvmea(jlev,jboxl,jadd,jvar,jt) |
---|
| 549 | ENDDO |
---|
| 550 | CLOSE(10) |
---|
| 551 | ENDDO |
---|
| 552 | ENDDO |
---|
| 553 | ENDDO |
---|
| 554 | ENDDO |
---|
| 555 | |
---|
| 556 | DO jt=1,ntyp |
---|
| 557 | DO jvar=1,nvar |
---|
| 558 | jboxl=0 |
---|
| 559 | DO jbox=1,nboxuser |
---|
| 560 | IF (lskipbox(jbox)) CYCLE |
---|
| 561 | jboxl=jboxl+1 |
---|
| 562 | WRITE(filename,'(7A)')TRIM(cname(jvar)),'_',& |
---|
| 563 | & TRIM(cl_boxes_user(jbox)),'_',& |
---|
| 564 | & TRIM(ADJUSTL(ctyp(jt))),'.dat' |
---|
[2945] | 565 | OPEN(10,file=TRIM(filename)) |
---|
| 566 | DO jlev = 1, nmlev |
---|
[3000] | 567 | WRITE(10,'(F16.7,2I12,F17.10)') zlev(jlev), & |
---|
| 568 | & jlev, inuma(jlev,jboxl,jvar,jt), & |
---|
| 569 | & zoamean(jlev,jboxl,jvar,jt) |
---|
[2945] | 570 | ENDDO |
---|
| 571 | CLOSE(10) |
---|
| 572 | ENDDO |
---|
| 573 | ENDDO |
---|
| 574 | ENDDO |
---|
| 575 | |
---|
[3000] | 576 | IF (lhistogram) THEN |
---|
| 577 | DO jt=1,ntyp |
---|
| 578 | DO jvar=1,nvar |
---|
| 579 | DO jadd=1,nadd |
---|
| 580 | jboxl=0 |
---|
| 581 | DO jbox=1,nboxuser |
---|
| 582 | IF (lskipbox(jbox)) CYCLE |
---|
| 583 | jboxl=jboxl+1 |
---|
| 584 | WRITE(filename,'(7A)')TRIM(cname(jvar)),& |
---|
| 585 | & TRIM(caddname(jadd)),'_',& |
---|
| 586 | & TRIM(cl_boxes_user(jbox)),'_',& |
---|
| 587 | & TRIM(ADJUSTL(ctyp(jt))),& |
---|
| 588 | & '_histogram.dat' |
---|
| 589 | OPEN(10,file=TRIM(filename)) |
---|
| 590 | WRITE(10,'(A10,1000F10.2)')'#',(zlev(jlev),jlev=1,nmlev) |
---|
| 591 | DO ji=1,hist(jvar)%npoints |
---|
| 592 | WRITE(10,'(F10.2,1000I10)') & |
---|
| 593 | & zhistmin(jvar)+(ji-1)*zhiststep(jvar), & |
---|
| 594 | & (hist(jvar)%nhist(ji,jlev,jboxl,jadd,jt),jlev=1,nmlev) |
---|
| 595 | ENDDO |
---|
| 596 | CLOSE(10) |
---|
| 597 | ENDDO |
---|
[2945] | 598 | ENDDO |
---|
| 599 | ENDDO |
---|
| 600 | ENDDO |
---|
[3000] | 601 | ENDIF |
---|
| 602 | |
---|
[2945] | 603 | ENDIF |
---|
| 604 | |
---|
[3000] | 605 | IF (lnetcdf) THEN |
---|
| 606 | |
---|
| 607 | IF (nadd>0) THEN |
---|
| 608 | DO jt=1,ntyp |
---|
| 609 | WRITE(outfilename,'(3A)')'fbstat_',TRIM(ADJUSTL(ctyp(jt))),'.nc' |
---|
| 610 | CALL fbstat_ncwrite(TRIM(outfilename),& |
---|
| 611 | & nvar,cname,nadd,caddname,noberr,cobename,nbgerr,cbgename,& |
---|
| 612 | & nboxuser,nboxuserl,20,cl_boxes_user,lskipbox,nmlev,zlev,& |
---|
| 613 | & inum(:,:,:,:,jt),zbias(:,:,:,:,jt),zrms(:,:,:,:,jt), & |
---|
| 614 | & zsdev(:,:,:,:,jt),zomean(:,:,:,:,jt),zmmean(:,:,:,:,jt),& |
---|
| 615 | & inuma(:,:,:,jt),zoamean(:,:,:,jt), & |
---|
| 616 | & inumov(:,:,:,:,jt),zoemea(:,:,:,:,jt),zovmea(:,:,:,:,jt), & |
---|
| 617 | & inumbv(:,:,:,:,jt),zbemea(:,:,:,:,jt),zbvmea(:,:,:,:,jt) ) |
---|
| 618 | IF (lhistogram) THEN |
---|
| 619 | WRITE(outfilename,'(3A)')'fbstat_hist_',TRIM(ADJUSTL(ctyp(jt))),'.nc' |
---|
| 620 | CALL fbstat_ncwrite_hist(TRIM(outfilename),& |
---|
| 621 | & nvar,cname,nadd,caddname,& |
---|
| 622 | & nboxuser,20,cl_boxes_user,lskipbox,nmlev,zlev,& |
---|
| 623 | & hist,zhistmin,zhiststep,jt) |
---|
| 624 | ENDIF |
---|
| 625 | IF (lxyplot) THEN |
---|
| 626 | WRITE(outfilename,'(3A)')'fbstat_xyplot_',TRIM(ADJUSTL(ctyp(jt))),'.nc' |
---|
| 627 | CALL fbstat_ncwrite_xy(TRIM(outfilename),& |
---|
| 628 | & nvar,cname,nadd,caddname,& |
---|
| 629 | & nboxuser,20,cl_boxes_user,lskipbox,nmlev,zlev,& |
---|
| 630 | & xy,zxymin,zxystep,jt) |
---|
| 631 | ENDIF |
---|
| 632 | ENDDO |
---|
| 633 | ENDIF |
---|
| 634 | ENDIF |
---|
| 635 | |
---|
[2945] | 636 | IF (lomona) THEN |
---|
| 637 | |
---|
[3000] | 638 | IF (ntyp>1) THEN |
---|
| 639 | WRITE(*,*)'Omona file only supported for the first type which is : ',TRIM(ctyp(1)) |
---|
| 640 | ENDIF |
---|
[2945] | 641 | IF (nmlev>1) THEN |
---|
[3000] | 642 | ALLOCATE(zdat3d(nmlev,nboxuser,1)) |
---|
[2945] | 643 | ELSE |
---|
[3000] | 644 | ALLOCATE(zdat2d(nboxuser,1)) |
---|
[2945] | 645 | ENDIF |
---|
| 646 | |
---|
| 647 | cl_expnam=expver |
---|
| 648 | WRITE(cl_date,'(I8.8)')inidate |
---|
| 649 | i_dp = nmlev |
---|
| 650 | itime=icurdate |
---|
| 651 | linnerp=.TRUE. |
---|
| 652 | iloopno = loopno |
---|
| 653 | linnerini = linner |
---|
[3000] | 654 | i_fill=0 |
---|
| 655 | |
---|
| 656 | DO jt=1,ntyp |
---|
| 657 | DO jvar = 1, nvar |
---|
| 658 | linner = linnerini |
---|
| 659 | loopno = iloopno |
---|
| 660 | SELECT CASE (TRIM(cname(jvar))) |
---|
| 661 | CASE('POTM') |
---|
| 662 | cl_var = 'votemper' |
---|
| 663 | CASE('PSAL') |
---|
| 664 | cl_var='vosaline' |
---|
| 665 | CASE('SLA') |
---|
| 666 | cl_var='sossheig' |
---|
| 667 | CASE('SST') |
---|
| 668 | cl_var='sosstsst' |
---|
| 669 | CASE('UVEL') |
---|
| 670 | cl_var='vozocrtx' |
---|
| 671 | CASE('VVEL') |
---|
| 672 | cl_var='vomecrty' |
---|
| 673 | END SELECT |
---|
| 674 | DO jadd = 1, nadd |
---|
| 675 | linner = (caddname(jadd)(1:3)=='Hxa').OR.linner |
---|
| 676 | IF (lpassive) THEN |
---|
| 677 | ityp=145 |
---|
[2945] | 678 | ELSE |
---|
[3000] | 679 | IF (linner) THEN |
---|
| 680 | linnerp=.TRUE. |
---|
| 681 | ityp=144 |
---|
[2945] | 682 | IF (jadd>1) loopno=loopno+1 |
---|
[3000] | 683 | ELSE |
---|
| 684 | ityp=142 |
---|
| 685 | IF (.NOT.linnerp) THEN |
---|
| 686 | IF (jadd>1) loopno=loopno+1 |
---|
| 687 | ENDIF |
---|
[2945] | 688 | ENDIF |
---|
| 689 | ENDIF |
---|
[3000] | 690 | WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',& |
---|
| 691 | & TRIM(ADJUSTL(ctyp(jt))) |
---|
| 692 | CALL obs_variable_att(cltyp) |
---|
| 693 | IF (nmlev>1) THEN |
---|
| 694 | zdat3d(:,:,1) = zbias(:,:,jadd,jvar,jt) |
---|
| 695 | i_fill=0 |
---|
| 696 | CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, & |
---|
| 697 | & cl_boxes_user,REAL(fbrmdi),i_fill) |
---|
| 698 | CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev) |
---|
[2945] | 699 | ELSE |
---|
[3000] | 700 | zdat2d(:,1) = zbias(1,:,jadd,jvar,jt) |
---|
| 701 | i_fill=0 |
---|
| 702 | CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, & |
---|
| 703 | & cl_boxes_user,REAL(fbrmdi),i_fill) |
---|
[2945] | 704 | ENDIF |
---|
[3000] | 705 | IF (lpassive) THEN |
---|
| 706 | ityp=245 |
---|
| 707 | ELSE |
---|
| 708 | IF (linner) THEN |
---|
| 709 | ityp=244 |
---|
| 710 | ELSE |
---|
| 711 | ityp=242 |
---|
| 712 | ENDIF |
---|
| 713 | ENDIF |
---|
| 714 | WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',& |
---|
| 715 | & TRIM(ADJUSTL(ctyp(jt))) |
---|
| 716 | CALL obs_variable_att(cltyp) |
---|
| 717 | IF (nmlev>1) THEN |
---|
| 718 | zdat3d(:,:,1) = zrms(:,:,jadd,jvar,jt) |
---|
| 719 | i_fill=0 |
---|
| 720 | CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, & |
---|
| 721 | & cl_boxes_user,REAL(fbrmdi),i_fill) |
---|
| 722 | CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev) |
---|
| 723 | ELSE |
---|
| 724 | zdat2d(:,1) = zrms(1,:,jadd,jvar,jt) |
---|
| 725 | i_fill=0 |
---|
| 726 | CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, & |
---|
| 727 | & cl_boxes_user,REAL(fbrmdi),i_fill) |
---|
| 728 | ENDIF |
---|
| 729 | IF (lpassive) THEN |
---|
| 730 | ityp=345 |
---|
| 731 | ELSE |
---|
| 732 | IF (linner) THEN |
---|
| 733 | ityp=344 |
---|
| 734 | ELSE |
---|
| 735 | ityp=342 |
---|
| 736 | ENDIF |
---|
| 737 | ENDIF |
---|
| 738 | WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',& |
---|
| 739 | & TRIM(ADJUSTL(ctyp(jt))) |
---|
| 740 | CALL obs_variable_att(cltyp) |
---|
| 741 | IF (nmlev>1) THEN |
---|
| 742 | zdat3d(:,:,1) = zsdev(:,:,jadd,jvar,jt) |
---|
| 743 | i_fill=0 |
---|
| 744 | CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, & |
---|
| 745 | & cl_boxes_user,REAL(fbrmdi),i_fill) |
---|
| 746 | CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev) |
---|
| 747 | ELSE |
---|
| 748 | zdat2d(:,1) = zsdev(1,:,jadd,jvar,jt) |
---|
| 749 | i_fill=0 |
---|
| 750 | CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, & |
---|
| 751 | & cl_boxes_user,REAL(fbrmdi),i_fill) |
---|
| 752 | ENDIF |
---|
| 753 | IF (lpassive) THEN |
---|
| 754 | ityp=445 |
---|
| 755 | ELSE |
---|
| 756 | IF (linner) THEN |
---|
| 757 | ityp=444 |
---|
| 758 | ELSE |
---|
| 759 | ityp=442 |
---|
| 760 | ENDIF |
---|
| 761 | ENDIF |
---|
| 762 | WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',& |
---|
| 763 | & TRIM(ADJUSTL(ctyp(jt))) |
---|
| 764 | CALL obs_variable_att(cltyp) |
---|
| 765 | IF (nmlev>1) THEN |
---|
| 766 | zdat3d(:,:,1) = inum(:,:,jadd,jvar,jt) |
---|
| 767 | i_fill=0 |
---|
| 768 | CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, & |
---|
| 769 | & cl_boxes_user,REAL(fbrmdi),i_fill) |
---|
| 770 | CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev) |
---|
| 771 | ELSE |
---|
| 772 | zdat2d(:,1) = inum(1,:,jadd,jvar,jt) |
---|
| 773 | i_fill=0 |
---|
| 774 | CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, & |
---|
| 775 | & cl_boxes_user,REAL(fbrmdi),i_fill) |
---|
| 776 | ENDIF |
---|
| 777 | IF (lpassive) THEN |
---|
| 778 | ityp=545 |
---|
| 779 | ELSE |
---|
| 780 | IF (linner) THEN |
---|
| 781 | ityp=544 |
---|
| 782 | ELSE |
---|
| 783 | ityp=542 |
---|
| 784 | ENDIF |
---|
| 785 | ENDIF |
---|
| 786 | WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',& |
---|
| 787 | & TRIM(ADJUSTL(ctyp(jt))) |
---|
| 788 | CALL obs_variable_att(cltyp) |
---|
| 789 | IF (nmlev>1) THEN |
---|
| 790 | zdat3d(:,:,1) = zomean(:,:,jadd,jvar,jt) |
---|
| 791 | i_fill=0 |
---|
| 792 | CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, & |
---|
| 793 | & cl_boxes_user,REAL(fbrmdi),i_fill) |
---|
| 794 | CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev) |
---|
| 795 | ELSE |
---|
| 796 | zdat2d(:,1) = zomean(1,:,jadd,jvar,jt) |
---|
| 797 | i_fill=0 |
---|
| 798 | CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, & |
---|
| 799 | & cl_boxes_user,REAL(fbrmdi),i_fill) |
---|
| 800 | ENDIF |
---|
| 801 | IF (lpassive) THEN |
---|
| 802 | ityp=645 |
---|
| 803 | ELSE |
---|
| 804 | IF (linner) THEN |
---|
| 805 | ityp=644 |
---|
| 806 | ELSE |
---|
| 807 | ityp=642 |
---|
| 808 | ENDIF |
---|
| 809 | ENDIF |
---|
| 810 | WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',& |
---|
| 811 | & TRIM(ADJUSTL(ctyp(jt))) |
---|
| 812 | CALL obs_variable_att(cltyp) |
---|
| 813 | IF (nmlev>1) THEN |
---|
| 814 | zdat3d(:,:,1) = zmmean(:,:,jadd,jvar,jt) |
---|
| 815 | i_fill=0 |
---|
| 816 | CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, & |
---|
| 817 | & cl_boxes_user,REAL(fbrmdi),i_fill) |
---|
| 818 | CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev) |
---|
| 819 | ELSE |
---|
| 820 | zdat2d(:,1) = zmmean(1,:,jadd,jvar,jt) |
---|
| 821 | i_fill=0 |
---|
| 822 | CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, & |
---|
| 823 | & cl_boxes_user,REAL(fbrmdi),i_fill) |
---|
| 824 | ENDIF |
---|
| 825 | linner=.FALSE. |
---|
| 826 | ENDDO |
---|
| 827 | loopno = iloopno |
---|
| 828 | DO jadd = 1, noberr |
---|
| 829 | linner = .TRUE. |
---|
| 830 | ityp = 139 |
---|
| 831 | IF (jadd>1) loopno=loopno+1 |
---|
| 832 | WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',& |
---|
| 833 | & TRIM(ADJUSTL(ctyp(jt))) |
---|
| 834 | CALL obs_variable_att(cltyp) |
---|
| 835 | IF (nmlev>1) THEN |
---|
| 836 | zdat3d(:,:,1) = zoemea(:,:,jadd,jvar,jt) |
---|
| 837 | i_fill=0 |
---|
| 838 | CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, & |
---|
| 839 | & cl_boxes_user,REAL(fbrmdi),i_fill) |
---|
| 840 | CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev) |
---|
| 841 | ELSE |
---|
| 842 | zdat2d(:,1) = zoemea(1,:,jadd,jvar,jt) |
---|
| 843 | i_fill=0 |
---|
| 844 | CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, & |
---|
| 845 | & cl_boxes_user,REAL(fbrmdi),i_fill) |
---|
| 846 | ENDIF |
---|
| 847 | ityp = 239 |
---|
| 848 | WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',& |
---|
| 849 | & TRIM(ADJUSTL(ctyp(jt))) |
---|
| 850 | CALL obs_variable_att(cltyp) |
---|
| 851 | IF (nmlev>1) THEN |
---|
| 852 | zdat3d(:,:,1) = zovmea(:,:,jadd,jvar,jt) |
---|
| 853 | i_fill=0 |
---|
| 854 | CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, & |
---|
| 855 | & cl_boxes_user,REAL(fbrmdi),i_fill) |
---|
| 856 | CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev) |
---|
| 857 | ELSE |
---|
| 858 | zdat2d(:,1) = zovmea(1,:,jadd,jvar,jt) |
---|
| 859 | i_fill=0 |
---|
| 860 | CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, & |
---|
| 861 | & cl_boxes_user,REAL(fbrmdi),i_fill) |
---|
| 862 | ENDIF |
---|
| 863 | ENDDO |
---|
| 864 | loopno = iloopno |
---|
| 865 | DO jadd = 1, nbgerr |
---|
| 866 | linner = .TRUE. |
---|
| 867 | ityp = 141 |
---|
| 868 | IF (jadd>1) loopno=loopno+1 |
---|
| 869 | WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',& |
---|
| 870 | & TRIM(ADJUSTL(ctyp(jt))) |
---|
| 871 | CALL obs_variable_att(cltyp) |
---|
| 872 | IF (nmlev>1) THEN |
---|
| 873 | zdat3d(:,:,1) = zbemea(:,:,jadd,jvar,jt) |
---|
| 874 | i_fill=0 |
---|
| 875 | CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, & |
---|
| 876 | & cl_boxes_user,REAL(fbrmdi),i_fill) |
---|
| 877 | CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev) |
---|
| 878 | ELSE |
---|
| 879 | zdat2d(:,1) = zbemea(1,:,jadd,jvar,jt) |
---|
| 880 | i_fill=0 |
---|
| 881 | CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, & |
---|
| 882 | & cl_boxes_user,REAL(fbrmdi),i_fill) |
---|
| 883 | ENDIF |
---|
| 884 | ityp = 241 |
---|
| 885 | WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',& |
---|
| 886 | & TRIM(ADJUSTL(ctyp(jt))) |
---|
| 887 | CALL obs_variable_att(cltyp) |
---|
| 888 | IF (nmlev>1) THEN |
---|
| 889 | zdat3d(:,:,1) = zbvmea(:,:,jadd,jvar,jt) |
---|
| 890 | i_fill=0 |
---|
| 891 | CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, & |
---|
| 892 | & cl_boxes_user,REAL(fbrmdi),i_fill) |
---|
| 893 | CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev) |
---|
| 894 | ELSE |
---|
| 895 | zdat2d(:,1) = zbvmea(1,:,jadd,jvar,jt) |
---|
| 896 | i_fill=0 |
---|
| 897 | CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, & |
---|
| 898 | & cl_boxes_user,REAL(fbrmdi),i_fill) |
---|
| 899 | ENDIF |
---|
| 900 | ENDDO |
---|
[2945] | 901 | IF (lpassive) THEN |
---|
[3000] | 902 | ityp=745 |
---|
[2945] | 903 | ELSE |
---|
[3000] | 904 | ityp=742 |
---|
[2945] | 905 | ENDIF |
---|
[3000] | 906 | WRITE(cltyp,'(I3.3,A1,A)')ityp,'_',& |
---|
| 907 | & TRIM(ADJUSTL(ctyp(jt))) |
---|
[2945] | 908 | CALL obs_variable_att(cltyp) |
---|
| 909 | IF (nmlev>1) THEN |
---|
[3000] | 910 | zdat3d(:,:,1) = inuma(:,:,jvar,jt) |
---|
| 911 | i_fill=0 |
---|
[2945] | 912 | CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, & |
---|
[3000] | 913 | & cl_boxes_user,REAL(fbrmdi),i_fill) |
---|
| 914 | CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev) |
---|
[2945] | 915 | ELSE |
---|
[3000] | 916 | zdat2d(:,1) = inuma(1,:,jvar,jt) |
---|
| 917 | i_fill=0 |
---|
[2945] | 918 | CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, & |
---|
[3000] | 919 | & cl_boxes_user,REAL(fbrmdi),i_fill) |
---|
[2945] | 920 | ENDIF |
---|
| 921 | IF (lpassive) THEN |
---|
[3000] | 922 | ityp=845 |
---|
[2945] | 923 | ELSE |
---|
[3000] | 924 | ityp=842 |
---|
[2945] | 925 | ENDIF |
---|
[3000] | 926 | WRITE(cltyp,'(I3.3,A1,A)')ityp,'_',& |
---|
| 927 | & TRIM(ADJUSTL(ctyp(jt))) |
---|
[2945] | 928 | CALL obs_variable_att(cltyp) |
---|
| 929 | IF (nmlev>1) THEN |
---|
[3000] | 930 | zdat3d(:,:,1) = zoamean(:,:,jvar,jt) |
---|
| 931 | i_fill=0 |
---|
[2945] | 932 | CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, & |
---|
[3000] | 933 | & cl_boxes_user,REAL(fbrmdi),i_fill) |
---|
| 934 | CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev) |
---|
[2945] | 935 | ELSE |
---|
[3000] | 936 | zdat2d(:,1) = zoamean(1,:,jvar,jt) |
---|
| 937 | i_fill=0 |
---|
[2945] | 938 | CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, & |
---|
[3000] | 939 | & cl_boxes_user,REAL(fbrmdi),i_fill) |
---|
[2945] | 940 | ENDIF |
---|
| 941 | ENDDO |
---|
| 942 | ENDDO |
---|
| 943 | |
---|
| 944 | IF (nmlev>1) THEN |
---|
| 945 | DEALLOCATE(zdat3d) |
---|
| 946 | ELSE |
---|
| 947 | DEALLOCATE(zdat2d) |
---|
| 948 | ENDIF |
---|
| 949 | |
---|
| 950 | ENDIF |
---|
| 951 | |
---|
| 952 | CONTAINS |
---|
| 953 | |
---|
[3000] | 954 | SUBROUTINE fb_stat(fbdata,lskipbox,nmlev,zlev,lnear,kqc,kqco,lhist,lxyplot,& |
---|
| 955 | & ntyp,ctyp,ipdcst,mindcst) |
---|
[2945] | 956 | USE fbaccdata |
---|
| 957 | USE coords |
---|
| 958 | TYPE(obfbdata) :: fbdata |
---|
[3000] | 959 | LOGICAL, DIMENSION(nboxuser) :: lskipbox |
---|
[2945] | 960 | INTEGER :: nmlev |
---|
| 961 | REAL :: zlev(nmlev) |
---|
| 962 | LOGICAL :: lnear |
---|
[3000] | 963 | INTEGER :: kqc,kqco |
---|
| 964 | LOGICAL :: lhist,lxyplot |
---|
| 965 | INTEGER :: ntyp |
---|
| 966 | CHARACTER(len=ilentyp), DIMENSION(ntyp) :: ctyp |
---|
| 967 | INTEGER :: ipdcst |
---|
| 968 | REAL :: mindcst |
---|
| 969 | INTEGER, DIMENSION(nboxuser) :: jlboxnum |
---|
| 970 | INTEGER :: jlev, jobs, jvar, klev,jlev2,ih,ja,jadd,jbox,jt,ix,iy,jboxl |
---|
| 971 | REAL :: zarea(4),zlat,zlon,zdiff,zdiff2,zvar |
---|
[2945] | 972 | |
---|
[3000] | 973 | jboxl=0 |
---|
| 974 | jlboxnum=-1 |
---|
| 975 | DO jbox = 1, nboxuser |
---|
| 976 | IF (lskipbox(jbox)) CYCLE |
---|
| 977 | jboxl=jboxl+1 |
---|
| 978 | jlboxnum(jbox)=jboxl |
---|
| 979 | ENDDO |
---|
| 980 | |
---|
| 981 | !$omp parallel do default(shared) private(jlev,jobs,jvar,klev,jlev2,ih,ja,jadd,jbox,jt,ix,iy,jboxl,zarea,zlat,zlon,zdiff,zdiff2) |
---|
| 982 | DO jbox = 1, nboxuser |
---|
| 983 | IF (lskipbox(jbox)) CYCLE |
---|
| 984 | jboxl=jlboxnum(jbox) |
---|
| 985 | CALL coord_area_user(cl_boxes_user(jbox),zarea) |
---|
[2945] | 986 | DO jobs = 1, fbdata%nobs |
---|
[3000] | 987 | ! Reject observations with observation, position or time flag rejections |
---|
| 988 | IF (fbdata%ioqc(jobs)>kqco) CYCLE |
---|
| 989 | IF (fbdata%ipqc(jobs)>kqco) CYCLE |
---|
| 990 | IF (fbdata%itqc(jobs)>kqco) CYCLE |
---|
[2945] | 991 | zlat = fbdata%pphi(jobs) |
---|
| 992 | zlon = fbdata%plam(jobs) |
---|
| 993 | IF (zlon<0) zlon=zlon+360 |
---|
| 994 | IF (zlon>360) zlon=zlon-360 |
---|
| 995 | IF ( ( zlat .GE. zarea(3) ) .AND. & |
---|
| 996 | & ( zlat .LE. zarea(4) ) .AND. & |
---|
| 997 | & ( ( ( zlon .GE. zarea(1) ) .AND. & |
---|
| 998 | & ( zlon .LE. zarea(2) ) ) .OR. & |
---|
| 999 | & ( ( zarea(2) .LE. zarea(1) ) .AND. & |
---|
| 1000 | & ( zlon .GE. zarea(1) ) .AND. & |
---|
| 1001 | & ( zlon .LE. 360 ) ) .OR. & |
---|
| 1002 | & ( ( zarea(2) .LE. zarea(1) ) .AND. & |
---|
| 1003 | & ( zlon .GE. 0 ) .AND. & |
---|
| 1004 | & ( zlon .LE. zarea(2) ) ) ) ) THEN |
---|
| 1005 | |
---|
| 1006 | DO jlev = 1, fbdata%nlev |
---|
[3000] | 1007 | IF (ipdcst>0) THEN |
---|
| 1008 | IF (fbdata%pext(jlev,jobs,ipdcst)==fbrmdi) CYCLE |
---|
| 1009 | IF (fbdata%pext(jlev,jobs,ipdcst)<mindcst) CYCLE |
---|
| 1010 | ENDIF |
---|
[2945] | 1011 | DO jvar = 1, fbdata%nvar |
---|
| 1012 | IF (nmlev==1) THEN |
---|
| 1013 | klev=1 |
---|
| 1014 | ELSE |
---|
| 1015 | IF (lnear) THEN |
---|
| 1016 | zdiff=ABS(fbdata%pdep(jlev,jobs)-zlev(1)) |
---|
| 1017 | klev=1 |
---|
| 1018 | DO jlev2=2,nmlev |
---|
| 1019 | zdiff2=ABS(fbdata%pdep(jlev,jobs)-zlev(jlev2)) |
---|
| 1020 | IF (zdiff2<zdiff) THEN |
---|
| 1021 | klev=jlev2 |
---|
| 1022 | zdiff=zdiff2 |
---|
| 1023 | ENDIF |
---|
| 1024 | ENDDO |
---|
| 1025 | ELSE |
---|
| 1026 | klev = fbdata%iobsk(jlev,jobs,jvar)-1 |
---|
| 1027 | ENDIF |
---|
| 1028 | IF ( klev > nmlev ) THEN |
---|
[3000] | 1029 | DO ja = 1, fbdata%nadd |
---|
| 1030 | IF ( fbdata%caddname(ja)(1:2) /= 'Hx' ) CYCLE |
---|
| 1031 | IF ( ABS(fbdata%padd(jlev,jobs,ja,jvar))<9000 ) THEN |
---|
[2945] | 1032 | WRITE(*,*)'Error in fb_stat' |
---|
| 1033 | WRITE(*,*)'Increase nmlev to at least ',klev |
---|
| 1034 | klev=nmlev |
---|
| 1035 | CALL abort |
---|
| 1036 | ENDIF |
---|
| 1037 | ENDDO |
---|
| 1038 | ENDIF |
---|
| 1039 | ENDIF |
---|
[3000] | 1040 | IF (( klev > 0 ).AND. & |
---|
| 1041 | &(ABS(fbdata%pob(jlev,jobs,jvar)) < 9000 )) THEN |
---|
| 1042 | DO jt=1,ntyp |
---|
| 1043 | IF (TRIM(ADJUSTL(ctyp(jt)))/='all') THEN |
---|
| 1044 | IF (TRIM(ADJUSTL(ctyp(jt)))/=TRIM(ADJUSTL(fbdata%cdtyp(jobs)))) CYCLE |
---|
| 1045 | ENDIF |
---|
| 1046 | inuma(klev,jboxl,jvar,jt) = inuma(klev,jboxl,jvar,jt) + 1 |
---|
| 1047 | zoamean(klev,jboxl,jvar,jt) = zoamean(klev,jboxl,jvar,jt) + & |
---|
| 1048 | & fbdata%pob(jlev,jobs,jvar) |
---|
| 1049 | ENDDO |
---|
| 1050 | ENDIF |
---|
| 1051 | IF ( fbdata%ivlqc(jlev,jobs,jvar) < 0 ) CYCLE |
---|
[2945] | 1052 | IF ( fbdata%ivlqc(jlev,jobs,jvar) > kqc ) CYCLE |
---|
| 1053 | IF (( klev > 0 ).AND. & |
---|
| 1054 | &(ABS(fbdata%pob(jlev,jobs,jvar)) < 9000 )) THEN |
---|
[3000] | 1055 | jadd = 0 |
---|
| 1056 | DO ja = 1, fbdata%nadd |
---|
| 1057 | IF ( fbdata%caddname(ja)(1:2) /= 'Hx' ) CYCLE |
---|
| 1058 | jadd = jadd + 1 |
---|
| 1059 | IF ( ABS(fbdata%padd(jlev,jobs,ja,jvar)) < 9000 ) THEN |
---|
| 1060 | zdiff = ( fbdata%padd(jlev,jobs,ja,jvar) - & |
---|
[2945] | 1061 | & fbdata%pob(jlev,jobs,jvar) ) |
---|
[3000] | 1062 | DO jt=1,ntyp |
---|
| 1063 | IF (TRIM(ADJUSTL(ctyp(jt)))/='all') THEN |
---|
| 1064 | IF (TRIM(ADJUSTL(ctyp(jt)))/=TRIM(ADJUSTL(fbdata%cdtyp(jobs)))) CYCLE |
---|
| 1065 | ENDIF |
---|
| 1066 | inum(klev,jboxl,jadd,jvar,jt) = inum(klev,jboxl,jadd,jvar,jt) + 1 |
---|
| 1067 | zbias(klev,jboxl,jadd,jvar,jt) = zbias(klev,jboxl,jadd,jvar,jt) + & |
---|
| 1068 | & zdiff |
---|
| 1069 | zrms(klev,jboxl,jadd,jvar,jt) = zrms(klev,jboxl,jadd,jvar,jt) + & |
---|
| 1070 | & zdiff * zdiff |
---|
| 1071 | zomean(klev,jboxl,jadd,jvar,jt) = zomean(klev,jboxl,jadd,jvar,jt) + & |
---|
| 1072 | & fbdata%pob(jlev,jobs,jvar) |
---|
| 1073 | zmmean(klev,jboxl,jadd,jvar,jt) = zmmean(klev,jboxl,jadd,jvar,jt) + & |
---|
| 1074 | & fbdata%padd(jlev,jobs,ja,jvar) |
---|
| 1075 | ENDDO |
---|
[2945] | 1076 | IF (ABS(zdiff)>zcheck(jvar)) THEN |
---|
| 1077 | WRITE(*,*)'Departure outside check range ',& |
---|
| 1078 | & TRIM(fbdata%cname(jvar)),' entry ',& |
---|
| 1079 | & fbdata%caddname(jadd) |
---|
| 1080 | WRITE(*,*)'Depar = ',zdiff |
---|
| 1081 | WRITE(*,*)'Check = ',zcheck(jvar) |
---|
| 1082 | WRITE(*,*)'Id = ',fbdata%cdwmo(jobs) |
---|
| 1083 | WRITE(*,*)'Lat = ',fbdata%pphi(jobs) |
---|
| 1084 | WRITE(*,*)'Lon = ',fbdata%plam(jobs) |
---|
| 1085 | WRITE(*,*)'Tim = ',fbdata%ptim(jobs) |
---|
| 1086 | WRITE(*,*)'Depth = ',fbdata%pdep(jlev,jobs) |
---|
| 1087 | WRITE(*,*)'Obs = ',fbdata%pob(jlev,jobs,jvar) |
---|
[3000] | 1088 | WRITE(*,*)'Var = ',fbdata%padd(jlev,jobs,ja,jvar) |
---|
[2945] | 1089 | WRITE(*,*)'QC = ',fbdata%ivlqc(jlev,jobs,jvar) |
---|
| 1090 | WRITE(*,*)'QCflag= ',fbdata%ivlqcf(:,jlev,jobs,jvar) |
---|
| 1091 | ENDIF |
---|
| 1092 | IF (lhist) THEN |
---|
| 1093 | ih=NINT((zdiff-zhistmin(jvar))/zhiststep(jvar))+1 |
---|
| 1094 | IF ((ih>=1).AND.(ih<=hist(jvar)%npoints)) THEN |
---|
[3000] | 1095 | DO jt=1,ntyp |
---|
| 1096 | IF (TRIM(ADJUSTL(ctyp(jt)))/='all') THEN |
---|
| 1097 | IF (TRIM(ADJUSTL(ctyp(jt)))/=TRIM(ADJUSTL(fbdata%cdtyp(jobs)))) CYCLE |
---|
| 1098 | ENDIF |
---|
| 1099 | hist(jvar)%nhist(ih,klev,jboxl,jadd,jt) = & |
---|
| 1100 | hist(jvar)%nhist(ih,klev,jboxl,jadd,jt) +1 |
---|
| 1101 | ENDDO |
---|
[2945] | 1102 | ELSE |
---|
| 1103 | WRITE(*,*)'Histogram value outside range for ',& |
---|
| 1104 | & TRIM(fbdata%cname(jvar)),' entry ',& |
---|
| 1105 | & fbdata%caddname(jadd) |
---|
| 1106 | WRITE(*,*)'Value = ',zdiff |
---|
| 1107 | WRITE(*,*)'Range = ',zhistmin(jvar),zhistmax(jvar) |
---|
| 1108 | WRITE(*,*)'Step = ',zhiststep(jvar) |
---|
| 1109 | WRITE(*,*)'Index = ',ih |
---|
[3000] | 1110 | WRITE(*,*)'Id = ',TRIM(fbdata%cdwmo(jobs)) |
---|
| 1111 | WRITE(*,*)'Typ = ',TRIM(fbdata%cdtyp(jobs)) |
---|
[2945] | 1112 | WRITE(*,*)'Lat = ',fbdata%pphi(jobs) |
---|
| 1113 | WRITE(*,*)'Lon = ',fbdata%plam(jobs) |
---|
| 1114 | WRITE(*,*)'Tim = ',fbdata%ptim(jobs) |
---|
| 1115 | WRITE(*,*)'Depth = ',fbdata%pdep(jlev,jobs) |
---|
| 1116 | WRITE(*,*)'Obs = ',fbdata%pob(jlev,jobs,jvar) |
---|
| 1117 | WRITE(*,*)'Var = ',fbdata%padd(jlev,jobs,jadd,jvar) |
---|
| 1118 | WRITE(*,*)'QC = ',fbdata%ivlqc(jlev,jobs,jvar) |
---|
| 1119 | WRITE(*,*)'QCflag= ',fbdata%ivlqcf(:,jlev,jobs,jvar) |
---|
| 1120 | ENDIF |
---|
| 1121 | ENDIF |
---|
[3000] | 1122 | IF (lxyplot) THEN |
---|
| 1123 | ix=NINT((fbdata%pob(jlev,jobs,jvar)-zxymin(jvar))/& |
---|
| 1124 | & zxystep(jvar))+1 |
---|
| 1125 | iy=NINT((fbdata%padd(jlev,jobs,ja,jvar)-zxymin(jvar))/& |
---|
| 1126 | & zxystep(jvar))+1 |
---|
| 1127 | IF ((ix>=1).AND.(ix<=xy(jvar)%npoints).AND. & |
---|
| 1128 | &(iy>=1).AND.(iy<=xy(jvar)%npoints)) THEN |
---|
| 1129 | DO jt=1,ntyp |
---|
| 1130 | IF (TRIM(ADJUSTL(ctyp(jt)))/='all') THEN |
---|
| 1131 | IF (TRIM(ADJUSTL(ctyp(jt)))/=TRIM(ADJUSTL(fbdata%cdtyp(jobs)))) CYCLE |
---|
| 1132 | ENDIF |
---|
| 1133 | xy(jvar)%nxy(ix,iy,klev,jboxl,jadd,jt) = & |
---|
| 1134 | xy(jvar)%nxy(ix,iy,klev,jboxl,jadd,jt) +1 |
---|
| 1135 | ENDDO |
---|
| 1136 | ELSE |
---|
| 1137 | WRITE(*,*)'xy plot values outside range for ',& |
---|
| 1138 | & TRIM(fbdata%cname(jvar)),' entry ',& |
---|
| 1139 | & fbdata%caddname(jadd) |
---|
| 1140 | WRITE(*,*)'Obs = ',fbdata%pob(jlev,jobs,jvar) |
---|
| 1141 | WRITE(*,*)'Model = ',fbdata%padd(jlev,jobs,ja,jvar) |
---|
| 1142 | WRITE(*,*)'Range = ',zxymin(jvar),zxymax(jvar) |
---|
| 1143 | WRITE(*,*)'Step = ',zxystep(jvar) |
---|
| 1144 | WRITE(*,*)'Index = ',ih |
---|
| 1145 | WRITE(*,*)'Id = ',TRIM(fbdata%cdwmo(jobs)) |
---|
| 1146 | WRITE(*,*)'Typ = ',TRIM(fbdata%cdtyp(jobs)) |
---|
| 1147 | WRITE(*,*)'Lat = ',fbdata%pphi(jobs) |
---|
| 1148 | WRITE(*,*)'Lon = ',fbdata%plam(jobs) |
---|
| 1149 | WRITE(*,*)'Tim = ',fbdata%ptim(jobs) |
---|
| 1150 | WRITE(*,*)'Depth = ',fbdata%pdep(jlev,jobs) |
---|
| 1151 | WRITE(*,*)'Obs = ',fbdata%pob(jlev,jobs,jvar) |
---|
| 1152 | WRITE(*,*)'Var = ',fbdata%padd(jlev,jobs,jadd,jvar) |
---|
| 1153 | WRITE(*,*)'QC = ',fbdata%ivlqc(jlev,jobs,jvar) |
---|
| 1154 | WRITE(*,*)'QCflag= ',fbdata%ivlqcf(:,jlev,jobs,jvar) |
---|
| 1155 | ENDIF |
---|
| 1156 | ENDIF |
---|
[2945] | 1157 | ENDIF |
---|
| 1158 | ENDDO |
---|
[3000] | 1159 | jadd = 0 |
---|
| 1160 | DO ja = 1, fbdata%nadd |
---|
| 1161 | IF ( fbdata%caddname(ja)(1:3) /= 'OBE' ) CYCLE |
---|
| 1162 | jadd = jadd + 1 |
---|
| 1163 | IF ( ABS(fbdata%padd(jlev,jobs,ja,jvar)) < 9000 ) THEN |
---|
| 1164 | zvar = fbdata%padd(jlev,jobs,ja,jvar)*fbdata%padd(jlev,jobs,ja,jvar) |
---|
| 1165 | DO jt=1,ntyp |
---|
| 1166 | IF (TRIM(ADJUSTL(ctyp(jt)))/='all') THEN |
---|
| 1167 | IF (TRIM(ADJUSTL(ctyp(jt)))/=TRIM(ADJUSTL(fbdata%cdtyp(jobs)))) CYCLE |
---|
| 1168 | ENDIF |
---|
| 1169 | inumov(klev,jboxl,jadd,jvar,jt) = inumov(klev,jboxl,jadd,jvar,jt) + 1 |
---|
| 1170 | zoemea(klev,jboxl,jadd,jvar,jt) = zoemea(klev,jboxl,jadd,jvar,jt) + & |
---|
| 1171 | & fbdata%padd(jlev,jobs,ja,jvar) |
---|
| 1172 | zovmea(klev,jboxl,jadd,jvar,jt) = zovmea(klev,jboxl,jadd,jvar,jt) + zvar |
---|
| 1173 | ENDDO |
---|
| 1174 | ENDIF |
---|
| 1175 | ENDDO |
---|
| 1176 | jadd = 0 |
---|
| 1177 | DO ja = 1, fbdata%nadd |
---|
| 1178 | IF ( fbdata%caddname(ja)(1:3) /= 'BGE' ) CYCLE |
---|
| 1179 | jadd = jadd + 1 |
---|
| 1180 | IF ( ABS(fbdata%padd(jlev,jobs,ja,jvar)) < 9000 ) THEN |
---|
| 1181 | zvar = fbdata%padd(jlev,jobs,ja,jvar)*fbdata%padd(jlev,jobs,ja,jvar) |
---|
| 1182 | DO jt=1,ntyp |
---|
| 1183 | IF (TRIM(ADJUSTL(ctyp(jt)))/='all') THEN |
---|
| 1184 | IF (TRIM(ADJUSTL(ctyp(jt)))/=TRIM(ADJUSTL(fbdata%cdtyp(jobs)))) CYCLE |
---|
| 1185 | ENDIF |
---|
| 1186 | inumbv(klev,jboxl,jadd,jvar,jt) = inumbv(klev,jboxl,jadd,jvar,jt) + 1 |
---|
| 1187 | zbemea(klev,jboxl,jadd,jvar,jt) = zbemea(klev,jboxl,jadd,jvar,jt) + & |
---|
| 1188 | & fbdata%padd(jlev,jobs,ja,jvar) |
---|
| 1189 | zbvmea(klev,jboxl,jadd,jvar,jt) = zbvmea(klev,jboxl,jadd,jvar,jt) + zvar |
---|
| 1190 | ENDDO |
---|
| 1191 | ENDIF |
---|
| 1192 | ENDDO |
---|
[2945] | 1193 | ENDIF |
---|
| 1194 | ENDDO |
---|
| 1195 | ENDDO |
---|
| 1196 | ENDIF |
---|
| 1197 | ENDDO |
---|
| 1198 | ENDDO |
---|
[3000] | 1199 | !$omp end parallel do |
---|
[2945] | 1200 | |
---|
| 1201 | END SUBROUTINE fb_stat |
---|
| 1202 | |
---|
[3000] | 1203 | SUBROUTINE fb_rmmean(fbdata) |
---|
| 1204 | TYPE(obfbdata) :: fbdata |
---|
| 1205 | INTEGER :: jadd,jmean |
---|
| 1206 | |
---|
| 1207 | jmean=0 |
---|
| 1208 | DO jadd=1,fbdata%nadd |
---|
| 1209 | IF (fbdata%caddname(jadd)(1:4)=='MEAN') THEN |
---|
| 1210 | jmean=jadd |
---|
| 1211 | EXIT |
---|
| 1212 | ENDIF |
---|
| 1213 | ENDDO |
---|
| 1214 | IF (jmean==0) THEN |
---|
| 1215 | WRITE(*,*)'Warning: MEAN additional variable not found' |
---|
| 1216 | RETURN |
---|
| 1217 | ENDIF |
---|
| 1218 | IF (fbdata%nobs>0) THEN |
---|
| 1219 | DO jadd=1,fbdata%nadd |
---|
| 1220 | IF (fbdata%caddname(jadd)(1:2)=='Hx') THEN |
---|
| 1221 | fbdata%padd(:,:,jadd,:)=fbdata%padd(:,:,jadd,:)& |
---|
| 1222 | & +fbdata%padd(:,:,jmean,:) |
---|
| 1223 | ENDIF |
---|
| 1224 | ENDDO |
---|
| 1225 | ENDIF |
---|
| 1226 | |
---|
| 1227 | END SUBROUTINE fb_rmmean |
---|
| 1228 | |
---|
[2945] | 1229 | SUBROUTINE getlevsmean(nmlev,zlev) |
---|
| 1230 | IMPLICIT NONE |
---|
| 1231 | INTEGER :: nmlev |
---|
| 1232 | REAL,DIMENSION(nmlev) :: zlev |
---|
| 1233 | REAL,DIMENSION(nmlev+1) :: ztmp |
---|
| 1234 | INTEGER :: i |
---|
| 1235 | |
---|
| 1236 | zlev(:)=9999.9 |
---|
| 1237 | CALL getlevs(nmlev+1,ztmp) |
---|
| 1238 | DO i=1,nmlev |
---|
| 1239 | zlev(i)=0.5*(ztmp(i)+ztmp(i+1)) |
---|
| 1240 | ENDDO |
---|
| 1241 | |
---|
| 1242 | END SUBROUTINE getlevsmean |
---|
| 1243 | |
---|
| 1244 | SUBROUTINE getlevs(nmlev,zlev) |
---|
| 1245 | IMPLICIT NONE |
---|
| 1246 | INTEGER :: nmlev |
---|
| 1247 | REAL,DIMENSION(nmlev) :: zlev |
---|
| 1248 | |
---|
| 1249 | zlev(:)=9999.9 |
---|
| 1250 | |
---|
| 1251 | IF (nmlev==42) THEN |
---|
| 1252 | zlev(1)=5.02159 |
---|
| 1253 | zlev(2)=15.07854 |
---|
| 1254 | zlev(3)=25.16046 |
---|
| 1255 | zlev(4)=35.27829 |
---|
| 1256 | zlev(5)=45.44776 |
---|
| 1257 | zlev(6)=55.69149 |
---|
| 1258 | zlev(7)=66.04198 |
---|
| 1259 | zlev(8)=76.54591 |
---|
| 1260 | zlev(9)=87.27029 |
---|
| 1261 | zlev(10)=98.31118 |
---|
| 1262 | zlev(11)=109.8062 |
---|
| 1263 | zlev(12)=121.9519 |
---|
| 1264 | zlev(13)=135.0285 |
---|
| 1265 | zlev(14)=149.4337 |
---|
| 1266 | zlev(15)=165.7285 |
---|
| 1267 | zlev(16)=184.6975 |
---|
| 1268 | zlev(17)=207.4254 |
---|
| 1269 | zlev(18)=235.3862 |
---|
| 1270 | zlev(19)=270.5341 |
---|
| 1271 | zlev(20)=315.3741 |
---|
| 1272 | zlev(21)=372.9655 |
---|
| 1273 | zlev(22)=446.8009 |
---|
| 1274 | zlev(23)=540.5022 |
---|
| 1275 | zlev(24)=657.3229 |
---|
| 1276 | zlev(25)=799.5496 |
---|
| 1277 | zlev(26)=967.9958 |
---|
| 1278 | zlev(27)=1161.806 |
---|
| 1279 | zlev(28)=1378.661 |
---|
| 1280 | zlev(29)=1615.291 |
---|
| 1281 | zlev(30)=1868.071 |
---|
| 1282 | zlev(31)=2133.517 |
---|
| 1283 | zlev(32)=2408.583 |
---|
| 1284 | zlev(33)=2690.780 |
---|
| 1285 | zlev(34)=2978.166 |
---|
| 1286 | zlev(35)=3269.278 |
---|
| 1287 | zlev(36)=3563.041 |
---|
| 1288 | zlev(37)=3858.676 |
---|
| 1289 | zlev(38)=4155.628 |
---|
| 1290 | zlev(39)=4453.502 |
---|
| 1291 | zlev(40)=4752.021 |
---|
| 1292 | zlev(41)=5050.990 |
---|
| 1293 | zlev(42)=5350.272 |
---|
| 1294 | ELSEIF (nmlev==31) THEN |
---|
| 1295 | zlev(1)=4.999938 |
---|
| 1296 | zlev(2)=15.00029 |
---|
| 1297 | zlev(3)=25.00176 |
---|
| 1298 | zlev(4)=35.00541 |
---|
| 1299 | zlev(5)=45.01332 |
---|
| 1300 | zlev(6)=55.0295 |
---|
| 1301 | zlev(7)=65.06181 |
---|
| 1302 | zlev(8)=75.12551 |
---|
| 1303 | zlev(9)=85.25037 |
---|
| 1304 | zlev(10)=95.49429 |
---|
| 1305 | zlev(11)=105.9699 |
---|
| 1306 | zlev(12)=116.8962 |
---|
| 1307 | zlev(13)=128.6979 |
---|
| 1308 | zlev(14)=142.1953 |
---|
| 1309 | zlev(15)=158.9606 |
---|
| 1310 | zlev(16)=181.9628 |
---|
| 1311 | zlev(17)=216.6479 |
---|
| 1312 | zlev(18)=272.4767 |
---|
| 1313 | zlev(19)=364.303 |
---|
| 1314 | zlev(20)=511.5348 |
---|
| 1315 | zlev(21)=732.2009 |
---|
| 1316 | zlev(22)=1033.217 |
---|
| 1317 | zlev(23)=1405.698 |
---|
| 1318 | zlev(24)=1830.885 |
---|
| 1319 | zlev(25)=2289.768 |
---|
| 1320 | zlev(26)=2768.242 |
---|
| 1321 | zlev(27)=3257.479 |
---|
| 1322 | zlev(28)=3752.442 |
---|
| 1323 | zlev(29)=4250.401 |
---|
| 1324 | zlev(30)=4749.913 |
---|
| 1325 | zlev(31)=5250.227 |
---|
| 1326 | ELSEIF (nmlev==1) THEN |
---|
| 1327 | zlev(1)=0.0 |
---|
| 1328 | ELSE |
---|
| 1329 | WRITE(*,*) 'Unknown number of levels' |
---|
| 1330 | CALL abort |
---|
| 1331 | ENDIF |
---|
| 1332 | |
---|
| 1333 | END SUBROUTINE getlevs |
---|
| 1334 | |
---|
| 1335 | END PROGRAM fbstat |
---|