- Timestamp:
- 2021-08-11T13:24:27+02:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/NEMO_4.0.4_generic_obs/src/OCE/OBS/obs_read_surf.F90
r15089 r15180 39 39 40 40 SUBROUTINE obs_rea_surf( surfdata, knumfiles, cdfilenames, & 41 & kvars, k extr, kstp, ddobsini, ddobsend, &41 & kvars, kadd, kextr, kstp, ddobsini, ddobsend, & 42 42 & ldignmis, ldmod, ldnightav, cdvars ) 43 43 !!--------------------------------------------------------------------- … … 66 66 & cdfilenames(knumfiles) ! File names to read in 67 67 INTEGER, INTENT(IN) :: kvars ! Number of variables in surfdata 68 INTEGER, INTENT(IN) :: kextr ! Number of extra fields for each var 68 INTEGER, INTENT(IN) :: kadd ! Number of additional fields 69 ! in addition to those in the input file(s) 70 INTEGER, INTENT(IN) :: kextr ! Number of extra fields 71 ! in addition to those in the input file(s) 69 72 INTEGER, INTENT(IN) :: kstp ! Ocean time-step index 70 73 LOGICAL, INTENT(IN) :: ldignmis ! Ignore missing files … … 78 81 CHARACTER(LEN=11), PARAMETER :: cpname='obs_rea_surf' 79 82 CHARACTER(len=8) :: clrefdate 80 CHARACTER(len=8), DIMENSION(:), ALLOCATABLE :: clvarsin 83 CHARACTER(len=ilenname), DIMENSION(:), ALLOCATABLE :: clvarsin 84 CHARACTER(len=ilenlong), DIMENSION(:), ALLOCATABLE :: cllongin 85 CHARACTER(len=ilenunit), DIMENSION(:), ALLOCATABLE :: clunitin 86 CHARACTER(len=ilengrid), DIMENSION(:), ALLOCATABLE :: clgridin 87 CHARACTER(len=ilenname), DIMENSION(:), ALLOCATABLE :: claddvarsin 88 CHARACTER(len=ilenlong), DIMENSION(:,:), ALLOCATABLE :: claddlongin 89 CHARACTER(len=ilenunit), DIMENSION(:,:), ALLOCATABLE :: claddunitin 90 CHARACTER(len=ilenname), DIMENSION(:), ALLOCATABLE :: clextvarsin 91 CHARACTER(len=ilenlong), DIMENSION(:), ALLOCATABLE :: clextlongin 92 CHARACTER(len=ilenunit), DIMENSION(:), ALLOCATABLE :: clextunitin 81 93 INTEGER :: ji 82 94 INTEGER :: jj 83 95 INTEGER :: jk 96 INTEGER :: jvar 97 INTEGER :: jext 98 INTEGER :: jadd 99 INTEGER :: jadd2 100 INTEGER :: iadd 101 INTEGER :: iaddin 102 INTEGER :: iextr 84 103 INTEGER :: iflag 85 104 INTEGER :: inobf … … 121 140 TYPE(obfbdata), POINTER, DIMENSION(:) :: & 122 141 & inpfiles 142 CHARACTER(LEN=256) :: cout1 ! Diagnostic output line 123 143 124 144 ! Local initialization … … 132 152 133 153 ALLOCATE( inpfiles(inobf) ) 154 155 iadd = 0 156 iextr = 0 134 157 135 158 surf_files : DO jj = 1, inobf … … 189 212 ENDIF 190 213 214 IF ( (iextr > 0) .AND. (inpfiles(jj)%next /= iextr) ) THEN 215 CALL ctl_stop( 'Number of extra variables not consistent', & 216 & ' with previous files for this type' ) 217 ELSE 218 iextr = inpfiles(jj)%next 219 ENDIF 220 221 ! Ignore model counterpart 222 iaddin = inpfiles(jj)%nadd 223 DO ji = 1, iaddin 224 IF ( TRIM(inpfiles(jj)%caddname(ji)) == 'Hx' ) THEN 225 iaddin = iaddin - 1 226 EXIT 227 ENDIF 228 END DO 229 IF ( ldmod .AND. ( inpfiles(jj)%nadd == iaddin ) ) THEN 230 CALL ctl_stop( 'Model not in input data' ) 231 ENDIF 232 233 IF ( (iadd > 0) .AND. (iaddin /= iadd) ) THEN 234 CALL ctl_stop( 'Number of additional variables not consistent', & 235 & ' with previous files for this type' ) 236 ELSE 237 iadd = iaddin 238 ENDIF 239 191 240 IF ( jj == 1 ) THEN 192 241 ALLOCATE( clvarsin( inpfiles(jj)%nvar ) ) 242 ALLOCATE( cllongin( inpfiles(jj)%nvar ) ) 243 ALLOCATE( clunitin( inpfiles(jj)%nvar ) ) 244 ALLOCATE( clgridin( inpfiles(jj)%nvar ) ) 193 245 DO ji = 1, inpfiles(jj)%nvar 194 246 clvarsin(ji) = inpfiles(jj)%cname(ji) 247 cllongin(ji) = inpfiles(jj)%coblong(ji) 248 clunitin(ji) = inpfiles(jj)%cobunit(ji) 249 clgridin(ji) = inpfiles(jj)%cgrid(ji) 195 250 IF ( clvarsin(ji) /= cdvars(ji) ) THEN 196 251 CALL ctl_stop( 'Feedback file variables do not match', & … … 198 253 ENDIF 199 254 END DO 255 IF ( iadd > 0 ) THEN 256 ALLOCATE( claddvarsin( iadd ) ) 257 ALLOCATE( claddlongin( iadd, inpfiles(jj)%nvar ) ) 258 ALLOCATE( claddunitin( iadd, inpfiles(jj)%nvar ) ) 259 jadd = 0 260 DO ji = 1, inpfiles(jj)%nadd 261 IF ( TRIM(inpfiles(jj)%caddname(ji)) /= 'Hx' ) THEN 262 jadd = jadd + 1 263 claddvarsin(jadd) = inpfiles(jj)%caddname(ji) 264 DO jk = 1, inpfiles(jj)%nvar 265 claddlongin(jadd,jk) = inpfiles(jj)%caddlong(ji,jk) 266 claddunitin(jadd,jk) = inpfiles(jj)%caddunit(ji,jk) 267 END DO 268 ENDIF 269 END DO 270 ENDIF 271 IF ( iextr > 0 ) THEN 272 ALLOCATE( clextvarsin( iextr ) ) 273 ALLOCATE( clextlongin( iextr ) ) 274 ALLOCATE( clextunitin( iextr ) ) 275 DO ji = 1, iextr 276 clextvarsin(ji) = inpfiles(jj)%cextname(ji) 277 clextlongin(ji) = inpfiles(jj)%cextlong(ji) 278 clextunitin(ji) = inpfiles(jj)%cextunit(ji) 279 END DO 280 ENDIF 200 281 ELSE 201 282 DO ji = 1, inpfiles(jj)%nvar … … 205 286 ENDIF 206 287 END DO 288 IF ( iadd > 0 ) THEN 289 jadd = 0 290 DO ji = 1, inpfiles(jj)%nadd 291 IF ( TRIM(inpfiles(jj)%caddname(ji)) /= 'Hx' ) THEN 292 jadd = jadd + 1 293 IF ( inpfiles(jj)%caddname(ji) /= claddvarsin(jadd) ) THEN 294 CALL ctl_stop( 'Feedback file additional variables not consistent', & 295 & ' with previous files for this type' ) 296 ENDIF 297 ENDIF 298 END DO 299 ENDIF 300 IF ( iextr > 0 ) THEN 301 DO ji = 1, iextr 302 IF ( inpfiles(jj)%cextname(ji) /= clextvarsin(ji) ) THEN 303 CALL ctl_stop( 'Feedback file extra variables not consistent', & 304 & ' with previous files for this type' ) 305 ENDIF 306 END DO 307 ENDIF 308 207 309 ENDIF 208 310 … … 351 453 & iindx ) 352 454 353 CALL obs_surf_alloc( surfdata, iobs, kvars, k extr, kstp, jpi, jpj )455 CALL obs_surf_alloc( surfdata, iobs, kvars, kadd+iadd, kextr+iextr, kstp, jpi, jpj ) 354 456 355 457 ! Read obs/positions, QC, all variable and assign to surfdata … … 358 460 359 461 surfdata%cvars(:) = clvarsin(:) 462 surfdata%clong(:) = cllongin(:) 463 surfdata%cunit(:) = clunitin(:) 464 surfdata%cgrid(:) = clgridin(:) 465 IF ( iadd > 0 ) THEN 466 surfdata%caddvars(kadd+1:) = claddvarsin(:) 467 surfdata%caddlong(kadd+1:,:) = claddlongin(:,:) 468 surfdata%caddunit(kadd+1:,:) = claddunitin(:,:) 469 ENDIF 470 IF ( iextr > 0 ) THEN 471 surfdata%cextvars(kextr+1:) = clextvarsin(:) 472 surfdata%cextlong(kextr+1:) = clextlongin(:) 473 surfdata%cextunit(kextr+1:) = clextunitin(:) 474 ENDIF 360 475 361 476 ityp (:) = 0 … … 433 548 surfdata%nsfil(iobs) = iindx(jk) 434 549 435 ! QC flags 436 surfdata%nqc(iobs) = inpfiles(jj)%ivqc(ji,1) 437 438 ! Observed value 439 surfdata%robs(iobs,1) = inpfiles(jj)%pob(1,ji,1) 440 441 442 ! Model and MDT is set to fbrmdi unless read from file 443 IF ( ldmod ) THEN 444 surfdata%rmod(iobs,1) = inpfiles(jj)%padd(1,ji,1,1) 445 IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) THEN 446 surfdata%rext(iobs,1) = inpfiles(jj)%padd(1,ji,2,1) 447 surfdata%rext(iobs,2) = inpfiles(jj)%pext(1,ji,1) 550 DO jvar = 1, kvars 551 552 ! QC flags 553 ! WHY IS THIS NOT A FUNCTION OF NUM VARS? 554 surfdata%nqc(iobs) = inpfiles(jj)%ivqc(ji,jvar) 555 556 ! Observed value 557 surfdata%robs(iobs,jvar) = inpfiles(jj)%pob(1,ji,jvar) 558 559 ! THIS NEEDS SORTING 560 ! ! Model and MDT is set to fbrmdi unless read from file 561 ! IF ( ldmod ) THEN 562 ! surfdata%rmod(iobs,jvar) = inpfiles(jj)%padd(1,ji,1,1) 563 ! IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) THEN 564 ! surfdata%rext(iobs,1) = inpfiles(jj)%padd(1,ji,2,1) 565 ! surfdata%rext(iobs,2) = inpfiles(jj)%pext(1,ji,1) 566 ! ENDIF 567 ! ELSE 568 ! surfdata%rmod(iobs,jvar) = fbrmdi 569 ! IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) surfdata%rext(iobs,:) = fbrmdi 570 ! ENDIF 571 572 ! Additional variables 573 surfdata%rmod(iobs,jvar) = fbrmdi 574 IF ( iadd > 0 ) THEN 575 jadd2 = 0 576 DO jadd = 1, inpfiles(jj)%nadd 577 IF ( TRIM(inpfiles(jj)%caddname(jadd)) == 'Hx' ) THEN 578 IF ( ldmod ) THEN 579 surfdata%rmod(iobs,jvar) = inpfiles(jj)%padd(1,ji,jadd,jvar) 580 ENDIF 581 ELSE 582 jadd2 = jadd2 + 1 583 surfdata%radd(iobs,kadd+jadd2,jvar) = & 584 & inpfiles(jj)%padd(1,ji,jadd,jvar) 585 ENDIF 586 END DO 448 587 ENDIF 449 ELSE 450 surfdata%rmod(iobs,1) = fbrmdi 451 IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) surfdata%rext(iobs,:) = fbrmdi 588 589 END DO 590 591 ! Extra variables 592 IF ( iextr > 0 ) THEN 593 DO jext = 1, iextr 594 surfdata%rext(iobs,kextr+jext) = inpfiles(jj)%pext(1,ji,jext) 595 END DO 452 596 ENDIF 453 597 ENDIF … … 467 611 !----------------------------------------------------------------------- 468 612 IF (lwp) THEN 469 613 DO jvar = 1, surfdata%nvar 614 IF ( jvar == 1 ) THEN 615 cout1=TRIM(surfdata%cvars(1)) 616 ELSE 617 WRITE(cout1,'(A,A1,A)') TRIM(cout1), '/', TRIM(surfdata%cvars(jvar)) 618 ENDIF 619 END DO 620 470 621 WRITE(numout,*) 471 WRITE(numout,'(1X,A)')TRIM( surfdata%cvars(1))//' data'622 WRITE(numout,'(1X,A)')TRIM( cout1 )//' data' 472 623 WRITE(numout,'(1X,A)')'--------------' 473 624 DO jj = 1,8 … … 479 630 & '---------------------------------------------------------------' 480 631 WRITE(numout,'(1X,A,I8)') & 481 & 'Total data for variable '//TRIM( surfdata%cvars(1))// &632 & 'Total data for variable '//TRIM( cout1 )// & 482 633 & ' = ', iobsmpp 483 634 WRITE(numout,'(1X,A)') & … … 490 641 ! Deallocate temporary data 491 642 !----------------------------------------------------------------------- 492 DEALLOCATE( ifileidx, isurfidx, zdat, clvarsin ) 643 DEALLOCATE( ifileidx, isurfidx, zdat, clvarsin, & 644 & cllongin, clunitin, clgridin ) 645 IF ( iadd > 0 ) THEN 646 DEALLOCATE( claddvarsin, claddlongin, claddunitin) 647 ENDIF 648 IF ( iextr > 0 ) THEN 649 DEALLOCATE( clextvarsin, clextlongin, clextunitin ) 650 ENDIF 493 651 494 652 !-----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
