Changeset 5682 for branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_surf.F90
- Timestamp:
- 2015-08-12T17:46:45+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_surf.F90
r5659 r5682 9 9 !!---------------------------------------------------------------------- 10 10 11 !! * Modules used 11 !! * Modules used 12 12 USE par_kind ! Precision variables 13 13 USE in_out_manager ! I/O manager … … 20 20 USE obs_surf_def ! Surface observation definitions 21 21 USE obs_types ! Observation type definitions 22 USE obs_fbm ! Feedback routines 22 23 USE netcdf ! NetCDF library 23 24 … … 28 29 29 30 PUBLIC obs_rea_surf ! Read the surface observations from the point data 30 31 31 32 !!---------------------------------------------------------------------- 32 33 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 37 38 CONTAINS 38 39 39 SUBROUTINE obs_rea_surf( surfdata, knumfiles, c filenames, &40 SUBROUTINE obs_rea_surf( surfdata, knumfiles, cdfilenames, & 40 41 & kvars, kextr, kstp, ddobsini, ddobsend, & 41 & ldignmis, ldmod )42 & ldignmis, ldmod, ldnightav ) 42 43 !!--------------------------------------------------------------------- 43 44 !! … … 59 60 60 61 !! * Arguments 61 TYPE(obs_surf), INTENT(INOUT) :: surfdata ! Surface data to be read 62 INTEGER, INTENT(IN) :: knumfiles ! Number of corio format files to read in 63 CHARACTER(LEN=128), INTENT(IN) :: cfilenames(knumfiles) ! File names to read in 62 TYPE(obs_surf), INTENT(INOUT) :: & 63 & surfdata ! Surface data to be read 64 INTEGER, INTENT(IN) :: knumfiles ! Number of corio format files to read 65 CHARACTER(LEN=128), INTENT(IN) :: & 66 & cdfilenames(knumfiles) ! File names to read in 64 67 INTEGER, INTENT(IN) :: kvars ! Number of variables in surfdata 65 INTEGER, INTENT(IN) :: kextr ! Number of extra fields for each var in surfdata68 INTEGER, INTENT(IN) :: kextr ! Number of extra fields for each var 66 69 INTEGER, INTENT(IN) :: kstp ! Ocean time-step index 67 70 LOGICAL, INTENT(IN) :: ldignmis ! Ignore missing files 68 71 LOGICAL, INTENT(IN) :: ldmod ! Initialize model from input data 69 REAL(KIND=dp), INTENT(IN) :: ddobsini ! Obs. ini time in YYYYMMDD.HHMMSS 70 REAL(KIND=dp), INTENT(IN) :: ddobsend ! Obs. end time in YYYYMMDD.HHMMSS 71 72 LOGICAL, INTENT(IN) :: ldnightav ! Observations represent a night-time average 73 REAL(dp), INTENT(IN) :: ddobsini ! Obs. ini time in YYYYMMDD.HHMMSS 74 REAL(dp), INTENT(IN) :: ddobsend ! Obs. end time in YYYYMMDD.HHMMSS 75 72 76 !! * Local declarations 73 77 CHARACTER(LEN=11), PARAMETER :: cpname='obs_rea_surf' 78 CHARACTER(len=8) :: clrefdate 79 CHARACTER(len=6), DIMENSION(:), ALLOCATABLE :: clvars 74 80 INTEGER :: ji 75 81 INTEGER :: jj … … 85 91 INTEGER :: imin 86 92 INTEGER :: isec 93 INTEGER :: itype 94 INTEGER :: iobsmpp 95 INTEGER :: iobs 96 INTEGER :: iobstot 97 INTEGER :: ios 98 INTEGER :: ioserrcount 99 INTEGER, PARAMETER :: jpsurfmaxtype = 1024 87 100 INTEGER, DIMENSION(knumfiles) :: irefdate 88 INTEGER :: iobsmpp 89 INTEGER, PARAMETER :: isurfmaxtype = 1024 90 INTEGER, DIMENSION(0:isurfmaxtype) :: & 101 INTEGER, DIMENSION(jpsurfmaxtype+1) :: & 91 102 & ityp, & 92 103 & itypmpp … … 98 109 & ifileidx, & 99 110 & isurfidx 100 INTEGER :: itype101 111 REAL(wp), DIMENSION(:), ALLOCATABLE :: & 102 112 & zphi, & 103 113 & zlam 104 real(wp), DIMENSION(:), ALLOCATABLE :: &114 REAL(wp), DIMENSION(:), ALLOCATABLE :: & 105 115 & zdat 116 REAL(wp), DIMENSION(knumfiles) :: & 117 & djulini, & 118 & djulend 106 119 LOGICAL :: llvalprof 107 120 TYPE(obfbdata), POINTER, DIMENSION(:) :: & 108 121 & inpfiles 109 real(wp), DIMENSION(knumfiles) :: & 110 & djulini, & 111 & djulend 112 INTEGER :: iobs 113 INTEGER :: iobstot 114 INTEGER :: ios 115 INTEGER :: ioserrcount 116 CHARACTER(len=8) :: cl_refdate 117 122 118 123 ! Local initialization 119 124 iobs = 0 120 121 !-----------------------------------------------------------------------122 ! Check data the model part is just with feedback data files123 !-----------------------------------------------------------------------124 IF ( ldmod .AND. ( kformat /= 0 ) ) THEN125 CALL ctl_stop( 'Model can only be read from feedback data' )126 RETURN127 ENDIF128 125 129 126 !----------------------------------------------------------------------- 130 127 ! Count the number of files needed and allocate the obfbdata type 131 128 !----------------------------------------------------------------------- 132 129 133 130 inobf = knumfiles 134 131 135 132 ALLOCATE( inpfiles(inobf) ) 136 133 137 134 surf_files : DO jj = 1, inobf 138 135 139 CALL init_obfbdata( inpfiles(jj) )140 141 136 !--------------------------------------------------------------------- 142 137 ! Prints … … 145 140 WRITE(numout,*) 146 141 WRITE(numout,*) ' obs_rea_surf : Reading from file = ', & 147 & TRIM( TRIM( c filenames(jj) ) )142 & TRIM( TRIM( cdfilenames(jj) ) ) 148 143 WRITE(numout,*) ' ~~~~~~~~~~~' 149 144 WRITE(numout,*) … … 153 148 ! Initialization: Open file and get dimensions only 154 149 !--------------------------------------------------------------------- 155 156 iflag = nf90_open( TRIM( TRIM( c filenames(jj) ) ), nf90_nowrite, &150 151 iflag = nf90_open( TRIM( TRIM( cdfilenames(jj) ) ), nf90_nowrite, & 157 152 & i_file_id ) 158 153 159 154 IF ( iflag /= nf90_noerr ) THEN 160 155 161 156 IF ( ldignmis ) THEN 162 157 inpfiles(jj)%nobs = 0 163 CALL ctl_warn( 'File ' // TRIM( TRIM( c filenames(jj) ) ) // &158 CALL ctl_warn( 'File ' // TRIM( TRIM( cdfilenames(jj) ) ) // & 164 159 & ' not found' ) 165 160 ELSE 166 CALL ctl_stop( 'File ' // TRIM( TRIM( c filenames(jj) ) ) // &161 CALL ctl_stop( 'File ' // TRIM( TRIM( cdfilenames(jj) ) ) // & 167 162 & ' not found' ) 168 163 ENDIF 169 164 170 165 ELSE 171 172 !------------------------------------------------------------------ 173 ! Close the file since it is opened in read_ proffile174 !------------------------------------------------------------------ 175 166 167 !------------------------------------------------------------------ 168 ! Close the file since it is opened in read_obfbdata 169 !------------------------------------------------------------------ 170 176 171 iflag = nf90_close( i_file_id ) 177 172 … … 179 174 ! Read the profile file into inpfiles 180 175 !------------------------------------------------------------------ 181 IF(lwp) THEN 182 WRITE(numout,*) 183 WRITE(numout,*)'Reading from feedback file :', & 184 & TRIM( cfilenames(jj) ) 185 ENDIF 186 CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), & 176 CALL init_obfbdata( inpfiles(jj) ) 177 CALL read_obfbdata( TRIM( cdfilenames(jj) ), inpfiles(jj), & 187 178 & ldgrid = .TRUE. ) 179 188 180 IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN 189 181 CALL ctl_stop( 'Model not in input data' ) … … 191 183 ENDIF 192 184 185 IF ( jj == 1 ) THEN 186 ALLOCATE( clvars( inpfiles(jj)%nvar ) ) 187 DO ji = 1, inpfiles(jj)%nvar 188 clvars(ji) = inpfiles(jj)%cname(ji) 189 END DO 190 ELSE 191 DO ji = 1, inpfiles(jj)%nvar 192 IF ( inpfiles(jj)%cname(ji) /= clvars(ji) ) THEN 193 CALL ctl_stop( 'Feedback file variables not consistent', & 194 & ' with previous files for this type' ) 195 ENDIF 196 END DO 197 ENDIF 198 193 199 !------------------------------------------------------------------ 194 200 ! Change longitude (-180,180) 195 201 !------------------------------------------------------------------ 196 202 197 DO ji = 1, inpfiles(jj)%nobs 203 DO ji = 1, inpfiles(jj)%nobs 198 204 199 205 IF ( inpfiles(jj)%plam(ji) < -180. ) & … … 208 214 ! Calculate the date (change eventually) 209 215 !------------------------------------------------------------------ 210 cl _refdate=inpfiles(jj)%cdjuldref(1:8)211 READ(cl _refdate,'(I8)') irefdate(jj)212 216 clrefdate=inpfiles(jj)%cdjuldref(1:8) 217 READ(clrefdate,'(I8)') irefdate(jj) 218 213 219 CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec ) 214 220 CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), & … … 217 223 CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(jj), & 218 224 & krefdate = irefdate(jj) ) 225 226 IF ( ldnightav ) THEN 227 228 IF ( lwp ) THEN 229 WRITE(numout,*)'Resetting time of night-time averaged observations', & 230 & ' to the end of the day' 231 ENDIF 232 233 DO ji = 1, inpfiles(jj)%nobs 234 ! for night-time averaged data force the time 235 ! to be the last time-step of the day, but still within the day. 236 IF ( inpfiles(jj)%ptim(ji) >= 0. ) THEN 237 inpfiles(jj)%ptim(ji) = & 238 & INT(inpfiles(jj)%ptim(ji)) + 0.9999 239 ELSE 240 inpfiles(jj)%ptim(ji) = & 241 & INT(inpfiles(jj)%ptim(ji)) - 0.0001 242 ENDIF 243 END DO 244 ENDIF 245 219 246 IF ( inpfiles(jj)%nobs > 0 ) THEN 220 247 inpfiles(jj)%iproc = -1 … … 312 339 & zdat, & 313 340 & iindx ) 314 341 315 342 CALL obs_surf_alloc( surfdata, iobs, kvars, kextr, kstp, jpi, jpj ) 316 317 ! *Read obs/positions, QC, all variable and assign to surfdata318 343 344 ! Read obs/positions, QC, all variable and assign to surfdata 345 319 346 iobs = 0 347 348 surfdata%cvars(:) = clvars(:) 320 349 321 350 ityp (:) = 0 322 351 itypmpp(:) = 0 323 352 324 353 ioserrcount = 0 325 354 326 355 DO jk = 1, iobstot 327 356 328 357 jj = ifileidx(iindx(jk)) 329 358 ji = isurfidx(iindx(jk)) 330 359 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 331 360 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN 332 361 333 362 IF ( nproc == 0 ) THEN 334 363 IF ( inpfiles(jj)%iproc(ji,1) > nproc ) CYCLE … … 336 365 IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE 337 366 ENDIF 338 367 339 368 ! Set observation information 340 369 341 370 IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. & 342 371 & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN … … 360 389 surfdata%nhou(iobs) = ihou 361 390 surfdata%nmin(iobs) = imin 362 391 363 392 ! Surface space coordinates 364 393 surfdata%rlam(iobs) = inpfiles(jj)%plam(ji) … … 368 397 surfdata%mi (iobs) = inpfiles(jj)%iobsi(ji,1) 369 398 surfdata%mj (iobs) = inpfiles(jj)%iobsj(ji,1) 370 399 371 400 ! Instrument type 372 401 READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 901 ) itype 373 402 901 IF ( ios /= 0 ) THEN 374 IF (ioserrcount == 0) CALL ctl_warn ( 'Problem converting an instrument type to integer. Setting type to zero' ) 403 IF (ioserrcount == 0) THEN 404 CALL ctl_warn ( 'Problem converting an instrument type ', & 405 & 'to integer. Setting type to zero' ) 406 ENDIF 375 407 ioserrcount = ioserrcount + 1 376 408 itype = 0 377 409 ENDIF 378 410 surfdata%ntyp(iobs) = itype 379 IF ( itype < isurfmaxtype + 1 ) THEN411 IF ( itype < jpsurfmaxtype + 1 ) THEN 380 412 ityp(itype+1) = ityp(itype+1) + 1 381 413 ELSE 382 IF(lwp)WRITE(numout,*)'WARNING:Increase isurfmaxtype in ',&414 IF(lwp)WRITE(numout,*)'WARNING:Increase jpsurfmaxtype in ',& 383 415 & cpname 384 416 ENDIF … … 398 430 IF ( ldmod ) THEN 399 431 surfdata%rmod(iobs,1) = inpfiles(jj)%padd(1,ji,1,1) 400 ELSE 432 IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) THEN 433 surfdata%rext(iobs,1) = inpfiles(jj)%padd(1,ji,2,1) 434 surfdata%rext(iobs,2) = inpfiles(jj)%pext(1,ji,1) 435 ENDIF 436 ELSE 401 437 surfdata%rmod(iobs,1) = fbrmdi 438 IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) surfdata%rext(iobs,:) = fbrmdi 402 439 ENDIF 403 440 ENDIF … … 409 446 ! Sum up over processors 410 447 !----------------------------------------------------------------------- 411 448 412 449 CALL obs_mpp_sum_integer( iobs, iobsmpp ) 413 450 CALL obs_mpp_sum_integers( ityp, itypmpp, jpsurfmaxtype + 1 ) 451 414 452 !----------------------------------------------------------------------- 415 453 ! Output number of observations. … … 418 456 419 457 WRITE(numout,*) 420 WRITE(numout,'(1X,A)') 'Surface data types'458 WRITE(numout,'(1X,A)')TRIM( surfdata%cvars(1) )//' data' 421 459 WRITE(numout,'(1X,A)')'--------------' 422 460 DO jj = 1,8 … … 425 463 ENDIF 426 464 END DO 427 WRITE(numout,'(1X,A50)')'--------------------------------------------------' 428 WRITE(numout,'(1X,A40,I10)')'Total = ',iobsmpp 465 WRITE(numout,'(1X,A)') & 466 & '---------------------------------------------------------------' 467 WRITE(numout,'(1X,A,I8)') & 468 & 'Total data for variable '//TRIM( surfdata%cvars(1) )// & 469 & ' = ', iobsmpp 470 WRITE(numout,'(1X,A)') & 471 & '---------------------------------------------------------------' 429 472 WRITE(numout,*) 430 473 … … 434 477 ! Deallocate temporary data 435 478 !----------------------------------------------------------------------- 436 DEALLOCATE( ifileidx, isurfidx, zdat )479 DEALLOCATE( ifileidx, isurfidx, zdat, clvars ) 437 480 438 481 !-----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.