Changeset 5659 for branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
- Timestamp:
- 2015-07-31T11:59:15+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
r4990 r5659 23 23 USE obs_fbm, ONLY: ln_cl4 ! Class 4 diagnostic switch 24 24 USE obs_read_prof ! Reading and allocation of observations (Coriolis) 25 USE obs_read_sla ! Reading and allocation of SLA observations 26 USE obs_read_sst ! Reading and allocation of SST observations 25 USE obs_read_surf ! Reading and allocation of SLA observations 27 26 USE obs_readmdt ! Reading and allocation of MDT for SLA. 28 USE obs_read_seaice ! Reading and allocation of Sea Ice observations29 USE obs_read_vel ! Reading and allocation of velocity component observations30 27 USE obs_prep ! Preparation of obs. (grid search etc). 31 28 USE obs_oper ! Observation operators … … 34 31 USE obs_read_altbias ! Bias treatment for altimeter 35 32 USE obs_profiles_def ! Profile data definitions 36 USE obs_profiles ! Profile data storage37 33 USE obs_surf_def ! Surface data definitions 38 USE obs_sla ! SLA data storage39 USE obs_sst ! SST data storage40 USE obs_seaice ! Sea Ice data storage41 34 USE obs_types ! Definitions for observation types 42 35 USE mpp_map ! MPP mapping … … 63 56 LOGICAL, PUBLIC :: ln_t3d !: Logical switch for temperature profiles 64 57 LOGICAL, PUBLIC :: ln_s3d !: Logical switch for salinity profiles 65 LOGICAL, PUBLIC :: ln_ena !: Logical switch for the ENACT data set66 LOGICAL, PUBLIC :: ln_cor !: Logical switch for the Coriolis data set67 LOGICAL, PUBLIC :: ln_profb !: Logical switch for profile feedback datafiles68 58 LOGICAL, PUBLIC :: ln_sla !: Logical switch for sea level anomalies 69 LOGICAL, PUBLIC :: ln_sladt !: Logical switch for SLA from AVISO files70 LOGICAL, PUBLIC :: ln_slafb !: Logical switch for SLA from feedback files71 59 LOGICAL, PUBLIC :: ln_sst !: Logical switch for sea surface temperature 72 LOGICAL, PUBLIC :: ln_reysst !: Logical switch for Reynolds sea surface temperature73 LOGICAL, PUBLIC :: ln_ghrsst !: Logical switch for GHRSST data74 LOGICAL, PUBLIC :: ln_sstfb !: Logical switch for SST from feedback files75 60 LOGICAL, PUBLIC :: ln_seaice !: Logical switch for sea ice concentration 76 61 LOGICAL, PUBLIC :: ln_vel3d !: Logical switch for velocity component (u,v) observations 77 LOGICAL, PUBLIC :: ln_velavcur !: Logical switch for raw daily averaged netCDF current meter vel. data78 LOGICAL, PUBLIC :: ln_velhrcur !: Logical switch for raw high freq netCDF current meter vel. data79 LOGICAL, PUBLIC :: ln_velavadcp !: Logical switch for raw daily averaged netCDF ADCP vel. data80 LOGICAL, PUBLIC :: ln_velhradcp !: Logical switch for raw high freq netCDF ADCP vel. data81 LOGICAL, PUBLIC :: ln_velfb !: Logical switch for velocities from feedback files82 62 LOGICAL, PUBLIC :: ln_ssh !: Logical switch for sea surface height 83 63 LOGICAL, PUBLIC :: ln_sss !: Logical switch for sea surface salinity … … 91 71 REAL(KIND=dp), PUBLIC :: dobsend !: Observation window end date YYYYMMDD.HHMMSS 92 72 73 INTEGER, PUBLIC :: numobtypes !: Number of observation types to read in. 93 74 INTEGER, PUBLIC :: n1dint !: Vertical interpolation method 94 75 INTEGER, PUBLIC :: n2dint !: Horizontal interpolation method 95 76 INTEGER, DIMENSION(:), ALLOCATABLE :: nvarsprof !Number of profile variables 77 INTEGER, DIMENSION(:), ALLOCATABLE :: nextrprof !Number of profile extra variables 78 INTEGER, DIMENSION(:), ALLOCATABLE :: nvarssurf !Number of surface variables 79 INTEGER, DIMENSION(:), ALLOCATABLE :: nextrsurf !Number of surface extra variables 96 80 INTEGER, DIMENSION(imaxavtypes) :: & 97 & endailyavtypes !: ENACT data types which are daily average 98 81 & dailyavtypes !: Data types which are daily average 82 83 TYPE(obs_surf), PUBLIC, POINTER, DIMENSION(:) :: surfdata ! Initial surface data 84 TYPE(obs_surf), PUBLIC, POINTER, DIMENSION(:) :: surfdataqc ! Surface data after quality control 85 TYPE(obs_prof), PUBLIC, POINTER, DIMENSION(:) :: profdata ! Initial profile data 86 TYPE(obs_prof), PUBLIC, POINTER, DIMENSION(:) :: profdataqc ! Profile data after quality control 87 88 CHARACTER(len=6), PUBLIC, DIMENSION(:), ALLOCATABLE :: obstypesprof 89 CHARACTER(len=6), PUBLIC, DIMENSION(:), ALLOCATABLE :: obstypessurf 90 91 92 99 93 INTEGER, PARAMETER :: MaxNumFiles = 1000 94 100 95 LOGICAL, DIMENSION(MaxNumFiles) :: & 101 96 & ln_profb_ena, & !: Is the feedback files from ENACT data ? 102 ! !: If so use endailyavtypes97 ! !: If so use dailyavtypes 103 98 & ln_profb_enatim !: Change tim for 820 enact data set. 104 99 … … 106 101 & ln_velfb_av !: Is the velocity feedback files daily average? 107 102 LOGICAL, DIMENSION(:), ALLOCATABLE :: & 108 & ld_enact !: Profile data is ENACT so use endailyavtypes103 & ld_enact !: Profile data is ENACT so use dailyavtypes 109 104 LOGICAL, DIMENSION(:), ALLOCATABLE :: & 110 105 & ld_velav !: Velocity data is daily averaged … … 135 130 !! ! 06-10 (A. Weaver) Cleaning and add controls 136 131 !! ! 07-03 (K. Mogensen) General handling of profiles 132 !! ! 15-02 (M. Martin) Simplification of namelist and code 137 133 !!---------------------------------------------------------------------- 138 134 … … 140 136 141 137 !! * Local declarations 142 CHARACTER(len=128) :: enactfiles(MaxNumFiles)143 CHARACTER(len=128) :: coriofiles(MaxNumFiles)144 138 CHARACTER(len=128) :: profbfiles(MaxNumFiles) 145 CHARACTER(len=128) :: sstfiles(MaxNumFiles) 146 CHARACTER(len=128) :: sstfbfiles(MaxNumFiles) 147 CHARACTER(len=128) :: slafilesact(MaxNumFiles) 148 CHARACTER(len=128) :: slafilespas(MaxNumFiles) 139 CHARACTER(len=128) :: sstfbfiles(MaxNumFiles) 149 140 CHARACTER(len=128) :: slafbfiles(MaxNumFiles) 150 CHARACTER(len=128) :: seaicefiles(MaxNumFiles) 151 CHARACTER(len=128) :: velcurfiles(MaxNumFiles) 152 CHARACTER(len=128) :: veladcpfiles(MaxNumFiles) 153 CHARACTER(len=128) :: velavcurfiles(MaxNumFiles) 154 CHARACTER(len=128) :: velhrcurfiles(MaxNumFiles) 155 CHARACTER(len=128) :: velavadcpfiles(MaxNumFiles) 156 CHARACTER(len=128) :: velhradcpfiles(MaxNumFiles) 141 CHARACTER(len=128) :: seaicefbfiles(MaxNumFiles) 157 142 CHARACTER(len=128) :: velfbfiles(MaxNumFiles) 158 CHARACTER(LEN=128) :: reysstname159 CHARACTER(LEN=12) :: reysstfmt160 143 CHARACTER(LEN=128) :: bias_file 161 144 CHARACTER(LEN=20) :: datestr=" ", timestr=" " 162 NAMELIST/namobs/ln_ena, ln_cor, ln_profb, ln_t3d, ln_s3d, & 163 & ln_sla, ln_sladt, ln_slafb, & 164 & ln_ssh, ln_sst, ln_sstfb, ln_sss, ln_nea, & 165 & enactfiles, coriofiles, profbfiles, & 166 & slafilesact, slafilespas, slafbfiles, & 167 & sstfiles, sstfbfiles, & 168 & ln_seaice, seaicefiles, & 145 146 NAMELIST/namobs/ln_t3d, ln_s3d, ln_sla, ln_sss, ln_ssh, & 147 & ln_sst, ln_seaice, ln_vel3d, & 148 & ln_altbias, ln_nea, ln_grid_global, & 149 & ln_grid_search_lookup, ln_cl4, & 150 & ln_ignmis, ln_s_at_t, ln_sstnight, & 151 & ln_profb_ena, ln_profb_enatim, & 152 & profbfiles, slafbfiles, sssfbfiles, & 153 & sshfbfiles, sstfbfiles, seaicefbfiles, & 154 & velfbfiles, bias_file, grid_search_file, & 169 155 & dobsini, dobsend, n1dint, n2dint, & 170 156 & nmsshc, mdtcorr, mdtcutoff, & 171 & ln_reysst, ln_ghrsst, reysstname, reysstfmt, & 172 & ln_sstnight, & 173 & ln_grid_search_lookup, & 174 & grid_search_file, grid_search_res, & 175 & ln_grid_global, bias_file, ln_altbias, & 176 & endailyavtypes, ln_s_at_t, ln_profb_ena, & 177 & ln_vel3d, ln_velavcur, velavcurfiles, & 178 & ln_velhrcur, velhrcurfiles, & 179 & ln_velavadcp, velavadcpfiles, & 180 & ln_velhradcp, velhradcpfiles, & 181 & ln_velfb, velfbfiles, ln_velfb_av, & 182 & ln_profb_enatim, ln_ignmis, ln_cl4 183 184 INTEGER :: jprofset 185 INTEGER :: jveloset 186 INTEGER :: jvar 187 INTEGER :: jnumenact 188 INTEGER :: jnumcorio 189 INTEGER :: jnumprofb 190 INTEGER :: jnumslaact 191 INTEGER :: jnumslapas 192 INTEGER :: jnumslafb 193 INTEGER :: jnumsst 194 INTEGER :: jnumsstfb 195 INTEGER :: jnumseaice 196 INTEGER :: jnumvelavcur 197 INTEGER :: jnumvelhrcur 198 INTEGER :: jnumvelavadcp 199 INTEGER :: jnumvelhradcp 200 INTEGER :: jnumvelfb 201 INTEGER :: ji 202 INTEGER :: jset 157 & grid_search_res, dailyavtypes 158 159 INTEGER :: jtype 203 160 INTEGER :: ios ! Local integer output status for namelist read 204 LOGICAL :: lmask(MaxNumFiles), ll_u3d, ll_v3d 205 161 INTEGER, DIMENSION(:), ALLOCATABLE :: jnumfilesprof 162 INTEGER, DIMENSION(:), ALLOCATABLE :: jnumfilessurf 163 CHARACTER(len=128), DIMENSION(:,:), ALLOCATABLE :: obsfilesprof 164 CHARACTER(len=128), DIMENSION(:,:), ALLOCATABLE :: obsfilessurf 165 LOGICAL :: lmask(MaxNumFiles) 206 166 !----------------------------------------------------------------------- 207 167 ! Read namelist parameters 208 168 !----------------------------------------------------------------------- 209 169 210 enactfiles(:) = ''211 coriofiles(:) = ''212 170 profbfiles(:) = '' 213 slafilesact(:) = ''214 slafilespas(:) = ''215 171 slafbfiles(:) = '' 216 sstfiles(:) = ''217 172 sstfbfiles(:) = '' 218 seaicefiles(:) = '' 219 velcurfiles(:) = '' 220 veladcpfiles(:) = '' 221 velavcurfiles(:) = '' 222 velhrcurfiles(:) = '' 223 velavadcpfiles(:) = '' 224 velhradcpfiles(:) = '' 173 seaicefbfiles(:) = '' 225 174 velfbfiles(:) = '' 226 velcurfiles(:) = '' 227 veladcpfiles(:) = '' 228 endailyavtypes(:) = -1 229 endailyavtypes(1) = 820 175 dailyavtypes(:) = -1 176 dailyavtypes(1) = 820 230 177 ln_profb_ena(:) = .FALSE. 231 178 ln_profb_enatim(:) = .TRUE. 232 179 ln_velfb_av(:) = .FALSE. 233 180 ln_ignmis = .FALSE. 234 181 235 182 CALL ini_date( dobsini ) 236 183 CALL fin_date( dobsend ) 237 184 238 185 ! Read Namelist namobs : control observation diagnostics 239 186 REWIND( numnam_ref ) ! Namelist namobs in reference namelist : Diagnostic: control observation … … 246 193 IF(lwm) WRITE ( numond, namobs ) 247 194 248 ! Count number of files for each type 249 IF (ln_ena) THEN 250 lmask(:) = .FALSE. 251 WHERE (enactfiles(:) /= '') lmask(:) = .TRUE. 252 jnumenact = COUNT(lmask) 253 ENDIF 254 IF (ln_cor) THEN 255 lmask(:) = .FALSE. 256 WHERE (coriofiles(:) /= '') lmask(:) = .TRUE. 257 jnumcorio = COUNT(lmask) 258 ENDIF 259 IF (ln_profb) THEN 260 lmask(:) = .FALSE. 261 WHERE (profbfiles(:) /= '') lmask(:) = .TRUE. 262 jnumprofb = COUNT(lmask) 263 ENDIF 264 IF (ln_sladt) THEN 265 lmask(:) = .FALSE. 266 WHERE (slafilesact(:) /= '') lmask(:) = .TRUE. 267 jnumslaact = COUNT(lmask) 268 lmask(:) = .FALSE. 269 WHERE (slafilespas(:) /= '') lmask(:) = .TRUE. 270 jnumslapas = COUNT(lmask) 271 ENDIF 272 IF (ln_slafb) THEN 273 lmask(:) = .FALSE. 274 WHERE (slafbfiles(:) /= '') lmask(:) = .TRUE. 275 jnumslafb = COUNT(lmask) 276 lmask(:) = .FALSE. 277 ENDIF 278 IF (ln_ghrsst) THEN 279 lmask(:) = .FALSE. 280 WHERE (sstfiles(:) /= '') lmask(:) = .TRUE. 281 jnumsst = COUNT(lmask) 282 ENDIF 283 IF (ln_sstfb) THEN 284 lmask(:) = .FALSE. 285 WHERE (sstfbfiles(:) /= '') lmask(:) = .TRUE. 286 jnumsstfb = COUNT(lmask) 287 lmask(:) = .FALSE. 288 ENDIF 289 IF (ln_seaice) THEN 290 lmask(:) = .FALSE. 291 WHERE (seaicefiles(:) /= '') lmask(:) = .TRUE. 292 jnumseaice = COUNT(lmask) 293 ENDIF 294 IF (ln_velavcur) THEN 295 lmask(:) = .FALSE. 296 WHERE (velavcurfiles(:) /= '') lmask(:) = .TRUE. 297 jnumvelavcur = COUNT(lmask) 298 ENDIF 299 IF (ln_velhrcur) THEN 300 lmask(:) = .FALSE. 301 WHERE (velhrcurfiles(:) /= '') lmask(:) = .TRUE. 302 jnumvelhrcur = COUNT(lmask) 303 ENDIF 304 IF (ln_velavadcp) THEN 305 lmask(:) = .FALSE. 306 WHERE (velavadcpfiles(:) /= '') lmask(:) = .TRUE. 307 jnumvelavadcp = COUNT(lmask) 308 ENDIF 309 IF (ln_velhradcp) THEN 310 lmask(:) = .FALSE. 311 WHERE (velhradcpfiles(:) /= '') lmask(:) = .TRUE. 312 jnumvelhradcp = COUNT(lmask) 313 ENDIF 314 IF (ln_velfb) THEN 315 lmask(:) = .FALSE. 316 WHERE (velfbfiles(:) /= '') lmask(:) = .TRUE. 317 jnumvelfb = COUNT(lmask) 318 lmask(:) = .FALSE. 319 ENDIF 320 321 ! Control print 195 !Set up list of observation types to be used 196 numproftypes = COUNT( (/ln_t3d .OR. ln_s3d, ln_vel3d /) ) 197 numsurftypes = COUNT( (/ln_sla, ln_sss, ln_sst, ln_seaice /) ) 198 IF ( numproftypes > 0 ) THEN 199 200 ALLOCATE( obstypesprof(numproftypes) ) 201 ALLOCATE( jnumfilesprof(numproftypes) ) 202 ALLOCATE( obsfilesprof(numproftypes, MaxNumFiles) ) 203 204 DO jtype = 1, numproftypes 205 IF (ln_t3d .OR. ln_s3d) THEN 206 obsfilesprof(:,jtype) = profbfiles(:) 207 obstypesprof(jtype) = 'prof' 208 ENDIF 209 IF (ln_vel3d) THEN 210 obsfilesprof(:,jtype) = velfbfiles(:) 211 obstypesprof(jtype) = 'vel' 212 ENDIF 213 214 lmask(:) = .FALSE. 215 WHERE (obsfilesprof(jtype,:) /= '') lmask(:) = .TRUE. 216 jnumfilesprof(jtype) = COUNT(lmask) 217 END DO 218 219 ENDIF 220 221 IF ( numsurftypes > 0 ) THEN 222 223 ALLOCATE( obstypessurf(numsurftypes) ) 224 ALLOCATE( jnumfilessurf(numproftypes) ) 225 ALLOCATE( obsfilessurf(numsurftypes, MaxNumFiles) ) 226 227 DO jtype = 1, numsurftypes 228 IF (ln_sla) THEN 229 obsfilessurf(:,jtype) = slafbfiles(:) 230 obstypessurf(jtype) = 'sla' 231 ENDIF 232 IF (ln_sss) THEN 233 obsfilessurf(:,jtype) = sssfbfiles(:) 234 obstypessurf(jtype) = 'sss' 235 ENDIF 236 IF (ln_sst) THEN 237 obsfilessurf(:,jtype) = sstfbfiles(:) 238 obstypessurf(jtype) = 'sst' 239 ENDIF 240 #if defined key_lim2 || defined key_lim3 241 IF (ln_seaice) THEN 242 obsfilessurf(:,jtype) = seaicefbfiles(:) 243 obstypessurf(jtype) = 'seaice' 244 ENDIF 245 #endif 246 247 lmask(:) = .FALSE. 248 WHERE (obsfilessurf(jtype,:) /= '') lmask(:) = .TRUE. 249 jnumfilessurf(jtype) = COUNT(lmask) 250 251 END DO 252 253 ENDIF 254 255 !Write namelist settings to stdout 322 256 IF(lwp) THEN 323 257 WRITE(numout,*) … … 327 261 WRITE(numout,*) ' Logical switch for T profile observations ln_t3d = ', ln_t3d 328 262 WRITE(numout,*) ' Logical switch for S profile observations ln_s3d = ', ln_s3d 329 WRITE(numout,*) ' Logical switch for ENACT insitu data set ln_ena = ', ln_ena330 WRITE(numout,*) ' Logical switch for Coriolis insitu data set ln_cor = ', ln_cor331 WRITE(numout,*) ' Logical switch for feedback insitu data set ln_profb = ', ln_profb332 263 WRITE(numout,*) ' Logical switch for SLA observations ln_sla = ', ln_sla 333 WRITE(numout,*) ' Logical switch for AVISO SLA data ln_sladt = ', ln_sladt334 WRITE(numout,*) ' Logical switch for feedback SLA data ln_slafb = ', ln_slafb335 264 WRITE(numout,*) ' Logical switch for SSH observations ln_ssh = ', ln_ssh 336 265 WRITE(numout,*) ' Logical switch for SST observations ln_sst = ', ln_sst 337 WRITE(numout,*) ' Logical switch for Reynolds observations ln_reysst = ', ln_reysst338 WRITE(numout,*) ' Logical switch for GHRSST observations ln_ghrsst = ', ln_ghrsst339 WRITE(numout,*) ' Logical switch for feedback SST data ln_sstfb = ', ln_sstfb340 266 WRITE(numout,*) ' Logical switch for night-time SST obs ln_sstnight = ', ln_sstnight 341 267 WRITE(numout,*) ' Logical switch for SSS observations ln_sss = ', ln_sss 342 268 WRITE(numout,*) ' Logical switch for Sea Ice observations ln_seaice = ', ln_seaice 343 269 WRITE(numout,*) ' Logical switch for velocity observations ln_vel3d = ', ln_vel3d 344 WRITE(numout,*) ' Logical switch for velocity daily av. cur. ln_velavcur = ', ln_velavcur 345 WRITE(numout,*) ' Logical switch for velocity high freq. cur. ln_velhrcur = ', ln_velhrcur 346 WRITE(numout,*) ' Logical switch for velocity daily av. ADCP ln_velavadcp = ', ln_velavadcp 347 WRITE(numout,*) ' Logical switch for velocity high freq. ADCP ln_velhradcp = ', ln_velhradcp 348 WRITE(numout,*) ' Logical switch for feedback velocity data ln_velfb = ', ln_velfb 349 WRITE(numout,*) ' Global distribtion of observations ln_grid_global = ',ln_grid_global 270 WRITE(numout,*) ' Global distribution of observations ln_grid_global = ',ln_grid_global 350 271 WRITE(numout,*) & 351 272 ' Logical switch for obs grid search w/lookup table ln_grid_search_lookup = ',ln_grid_search_lookup 352 273 IF (ln_grid_search_lookup) & 353 274 WRITE(numout,*) ' Grid search lookup file header grid_search_file = ', grid_search_file 354 IF (ln_ena) THEN 355 DO ji = 1, jnumenact 356 WRITE(numout,'(1X,2A)') ' ENACT input observation file name enactfiles = ', & 357 TRIM(enactfiles(ji)) 358 END DO 359 ENDIF 360 IF (ln_cor) THEN 361 DO ji = 1, jnumcorio 362 WRITE(numout,'(1X,2A)') ' Coriolis input observation file name coriofiles = ', & 363 TRIM(coriofiles(ji)) 364 END DO 365 ENDIF 366 IF (ln_profb) THEN 367 DO ji = 1, jnumprofb 368 IF (ln_profb_ena(ji)) THEN 369 WRITE(numout,'(1X,2A)') ' Enact feedback input observation file name profbfiles = ', & 370 TRIM(profbfiles(ji)) 371 ELSE 372 WRITE(numout,'(1X,2A)') ' Feedback input observation file name profbfiles = ', & 373 TRIM(profbfiles(ji)) 374 ENDIF 375 WRITE(numout,'(1X,2A)') ' Enact feedback input time setting switch ln_profb_enatim = ', ln_profb_enatim(ji) 376 END DO 377 ENDIF 378 IF (ln_sladt) THEN 379 DO ji = 1, jnumslaact 380 WRITE(numout,'(1X,2A)') ' Active SLA input observation file name slafilesact = ', & 381 TRIM(slafilesact(ji)) 382 END DO 383 DO ji = 1, jnumslapas 384 WRITE(numout,'(1X,2A)') ' Passive SLA input observation file name slafilespas = ', & 385 TRIM(slafilespas(ji)) 386 END DO 387 ENDIF 388 IF (ln_slafb) THEN 389 DO ji = 1, jnumslafb 390 WRITE(numout,'(1X,2A)') ' Feedback SLA input observation file name slafbfiles = ', & 391 TRIM(slafbfiles(ji)) 392 END DO 393 ENDIF 394 IF (ln_ghrsst) THEN 395 DO ji = 1, jnumsst 396 WRITE(numout,'(1X,2A)') ' GHRSST input observation file name sstfiles = ', & 397 TRIM(sstfiles(ji)) 398 END DO 399 ENDIF 400 IF (ln_sstfb) THEN 401 DO ji = 1, jnumsstfb 402 WRITE(numout,'(1X,2A)') ' Feedback SST input observation file name sstfbfiles = ', & 403 TRIM(sstfbfiles(ji)) 404 END DO 405 ENDIF 406 IF (ln_seaice) THEN 407 DO ji = 1, jnumseaice 408 WRITE(numout,'(1X,2A)') ' Sea Ice input observation file name seaicefiles = ', & 409 TRIM(seaicefiles(ji)) 410 END DO 411 ENDIF 412 IF (ln_velavcur) THEN 413 DO ji = 1, jnumvelavcur 414 WRITE(numout,'(1X,2A)') ' Vel. cur. daily av. input file name velavcurfiles = ', & 415 TRIM(velavcurfiles(ji)) 416 END DO 417 ENDIF 418 IF (ln_velhrcur) THEN 419 DO ji = 1, jnumvelhrcur 420 WRITE(numout,'(1X,2A)') ' Vel. cur. high freq. input file name velhvcurfiles = ', & 421 TRIM(velhrcurfiles(ji)) 422 END DO 423 ENDIF 424 IF (ln_velavadcp) THEN 425 DO ji = 1, jnumvelavadcp 426 WRITE(numout,'(1X,2A)') ' Vel. ADCP daily av. input file name velavadcpfiles = ', & 427 TRIM(velavadcpfiles(ji)) 428 END DO 429 ENDIF 430 IF (ln_velhradcp) THEN 431 DO ji = 1, jnumvelhradcp 432 WRITE(numout,'(1X,2A)') ' Vel. ADCP high freq. input file name velhvadcpfiles = ', & 433 TRIM(velhradcpfiles(ji)) 434 END DO 435 ENDIF 436 IF (ln_velfb) THEN 437 DO ji = 1, jnumvelfb 438 IF (ln_velfb_av(ji)) THEN 439 WRITE(numout,'(1X,2A)') ' Vel. feedback daily av. input file name velfbfiles = ', & 440 TRIM(velfbfiles(ji)) 441 ELSE 442 WRITE(numout,'(1X,2A)') ' Vel. feedback input observation file name velfbfiles = ', & 443 TRIM(velfbfiles(ji)) 444 ENDIF 445 END DO 446 ENDIF 447 WRITE(numout,*) ' Initial date in window YYYYMMDD.HHMMSS dobsini = ', dobsini 275 WRITE(numout,*) ' Initial date in window YYYYMMDD.HHMMSS dobsini = ', dobsin 448 276 WRITE(numout,*) ' Final date in window YYYYMMDD.HHMMSS dobsend = ', dobsend 449 277 WRITE(numout,*) ' Type of vertical interpolation method n1dint = ', n1dint … … 455 283 WRITE(numout,*) ' Logical switch for alt bias ln_altbias = ', ln_altbias 456 284 WRITE(numout,*) ' Logical switch for ignoring missing files ln_ignmis = ', ln_ignmis 457 WRITE(numout,*) ' ENACT daily average types = ',endailyavtypes 285 WRITE(numout,*) ' Daily average types = ', dailyavtypes 286 287 IF ( numproftypes > 0 ) THEN 288 DO jtype = 1, numproftypes 289 DO ji = 1, jnumfilesprof(jtype) 290 WRITE(numout,'(1X,2A)') ' '//obstypesprof(jtype)//' input observation file names = ', & 291 TRIM(obsfilesprof(jtype,ji)) 292 IF ( TRIM(obstypesprof(jtype)) == 'prof' ) & 293 WRITE(numout,'(1X,2A)') ' Enact feedback input time setting switch ln_profb_enatim = ', ln_profb_enatim(ji) 294 END DO 295 END DO 296 ENDIF 297 298 IF ( numsurftypes > 0 ) THEN 299 DO jtype = 1, numsurftypes 300 DO ji = 1, jnumfilessurf(jtype) 301 WRITE(numout,'(1X,2A)') ' '//obstypessurf(jtype)//' input observation file names = ', & 302 TRIM(obsfilessurf(jtype,ji)) 303 END DO 304 END DO 305 ENDIF 458 306 459 307 ENDIF … … 470 318 ! Parameter control 471 319 #if defined key_diaobs 472 IF ( ( .NOT. ln_t3d ).AND.( .NOT. ln_s3d ).AND.( .NOT. ln_sla ).AND. & 473 & ( .NOT. ln_vel3d ).AND. & 474 & ( .NOT. ln_ssh ).AND.( .NOT. ln_sst ).AND.( .NOT. ln_sss ).AND. & 475 & ( .NOT. ln_seaice ).AND.( .NOT. ln_vel3d ) ) THEN 320 IF ( numobtypes == 0 ) THEN 476 321 IF(lwp) WRITE(numout,cform_war) 477 322 IF(lwp) WRITE(numout,*) ' key_diaobs is activated but logical flags', & … … 494 339 ! Depending on switches read the various observation types 495 340 !----------------------------------------------------------------------- 496 ! - Temperature/salinity profiles 497 498 IF ( ln_t3d .OR. ln_s3d ) THEN 499 500 ! Set the number of variables for profiles to 2 (T and S) 501 nprofvars = 2 502 ! Set the number of extra variables for profiles to 1 (insitu temp). 503 nprofextr = 1 504 505 ! Count how may insitu data sets we have and allocate data. 506 jprofset = 0 507 IF ( ln_ena ) jprofset = jprofset + 1 508 IF ( ln_cor ) jprofset = jprofset + 1 509 IF ( ln_profb ) jprofset = jprofset + jnumprofb 510 nprofsets = jprofset 511 IF ( nprofsets > 0 ) THEN 512 ALLOCATE(ld_enact(nprofsets)) 513 ALLOCATE(profdata(nprofsets)) 514 ALLOCATE(prodatqc(nprofsets)) 515 ENDIF 516 517 jprofset = 0 518 519 ! ENACT insitu data 520 521 IF ( ln_ena ) THEN 522 523 jprofset = jprofset + 1 341 342 IF ( numproftypes > 0 ) THEN 343 344 ALLOCATE(profdata(numproftypes)) 345 ALLOCATE(profdataqc(numproftypes)) 346 ALLOCATE(nvarsprof(numproftypes)) 347 ALLOCATE(nextrprof(numproftypes)) 524 348 525 ld_enact(jprofset) = .TRUE. 526 527 CALL obs_rea_pro_dri( 1, profdata(jprofset), & 528 & jnumenact, enactfiles(1:jnumenact), & 529 & nprofvars, nprofextr, & 530 & nitend-nit000+2, & 531 & dobsini, dobsend, ln_t3d, ln_s3d, & 532 & ln_ignmis, ln_s_at_t, .TRUE., .FALSE., & 533 & kdailyavtypes = endailyavtypes ) 534 535 DO jvar = 1, 2 536 537 CALL obs_prof_staend( profdata(jprofset), jvar ) 538 349 DO jtype = 1, numproftypes 350 351 nvarsprof(jtype) = 2 352 IF ( TRIM(obstypesprof(jtype)) == 'prof' ) nextrprof(jtype) = 1 353 IF ( TRIM(obstypesprof(jtype)) == 'vel' ) nextrprof(jtype) = 2 354 355 !Read in profile or velocity obs types 356 CALL obs_rea_prof( profdata(jtype), & 357 & jnumfilesprof(jtype), & 358 & obsfilesprof(jtype,1:jnumfilesprof(jtype)), & 359 & nvarsprof(jtype), nextrprof(jtype), nitend-nit000+2, & 360 & dobsini, dobsend, ln_t3d, ln_s3d, & 361 & ln_ignmis, ln_s_at_t, .TRUE., .FALSE., & 362 & kdailyavtypes = dailyavtypes ) 363 364 DO jvar = 1, nvars 365 CALL obs_prof_staend( profdata(jtype), jvar ) 539 366 END DO 540 541 CALL obs_pre_pro ( profdata(jprofset), prodatqc(jprofset), &367 368 CALL obs_pre_prof( profdata(jtype), profdataqc(jtype), & 542 369 & ln_t3d, ln_s3d, ln_nea, & 543 & kdailyavtypes=endailyavtypes ) 544 545 ENDIF 546 547 ! Coriolis insitu data 548 549 IF ( ln_cor ) THEN 550 551 jprofset = jprofset + 1 552 553 ld_enact(jprofset) = .FALSE. 554 555 CALL obs_rea_pro_dri( 2, profdata(jprofset), & 556 & jnumcorio, coriofiles(1:jnumcorio), & 557 & nprofvars, nprofextr, & 558 & nitend-nit000+2, & 559 & dobsini, dobsend, ln_t3d, ln_s3d, & 560 & ln_ignmis, ln_s_at_t, .FALSE., .FALSE. ) 561 562 DO jvar = 1, 2 563 564 CALL obs_prof_staend( profdata(jprofset), jvar ) 565 566 END DO 567 568 CALL obs_pre_pro( profdata(jprofset), prodatqc(jprofset), & 569 & ln_t3d, ln_s3d, ln_nea ) 570 571 ENDIF 572 573 ! Feedback insitu data 574 575 IF ( ln_profb ) THEN 576 577 DO jset = 1, jnumprofb 578 579 jprofset = jprofset + 1 580 ld_enact (jprofset) = ln_profb_ena(jset) 581 582 CALL obs_rea_pro_dri( 0, profdata(jprofset), & 583 & 1, profbfiles(jset:jset), & 584 & nprofvars, nprofextr, & 585 & nitend-nit000+2, & 586 & dobsini, dobsend, ln_t3d, ln_s3d, & 587 & ln_ignmis, ln_s_at_t, & 588 & ld_enact(jprofset).AND.& 589 & ln_profb_enatim(jset), & 590 & .FALSE., kdailyavtypes = endailyavtypes ) 591 592 DO jvar = 1, 2 593 594 CALL obs_prof_staend( profdata(jprofset), jvar ) 595 596 END DO 597 598 IF ( ld_enact(jprofset) ) THEN 599 CALL obs_pre_pro( profdata(jprofset), prodatqc(jprofset), & 600 & ln_t3d, ln_s3d, ln_nea, & 601 & kdailyavtypes = endailyavtypes ) 602 ELSE 603 CALL obs_pre_pro( profdata(jprofset), prodatqc(jprofset), & 604 & ln_t3d, ln_s3d, ln_nea ) 605 ENDIF 606 607 END DO 608 609 ENDIF 610 611 ENDIF 612 613 ! - Sea level anomalies 614 IF ( ln_sla ) THEN 615 ! Set the number of variables for sla to 1 616 nslavars = 1 617 618 ! Set the number of extra variables for sla to 2 619 nslaextr = 2 620 621 ! Set the number of sla data sets to 2 622 nslasets = 0 623 IF ( ln_sladt ) THEN 624 nslasets = nslasets + 2 625 ENDIF 626 IF ( ln_slafb ) THEN 627 nslasets = nslasets + jnumslafb 628 ENDIF 629 630 ALLOCATE(sladata(nslasets)) 631 ALLOCATE(sladatqc(nslasets)) 632 sladata(:)%nsurf=0 633 sladatqc(:)%nsurf=0 634 635 nslasets = 0 636 637 ! AVISO SLA data 638 639 IF ( ln_sladt ) THEN 640 641 ! Active SLA observations 642 643 nslasets = nslasets + 1 644 645 CALL obs_rea_sla( 1, sladata(nslasets), jnumslaact, & 646 & slafilesact(1:jnumslaact), & 647 & nslavars, nslaextr, nitend-nit000+2, & 648 & dobsini, dobsend, ln_ignmis, .FALSE. ) 649 CALL obs_pre_sla( sladata(nslasets), sladatqc(nslasets), & 650 & ln_sla, ln_nea ) 651 652 ! Passive SLA observations 653 654 nslasets = nslasets + 1 655 656 CALL obs_rea_sla( 1, sladata(nslasets), jnumslapas, & 657 & slafilespas(1:jnumslapas), & 658 & nslavars, nslaextr, nitend-nit000+2, & 659 & dobsini, dobsend, ln_ignmis, .FALSE. ) 660 661 CALL obs_pre_sla( sladata(nslasets), sladatqc(nslasets), & 662 & ln_sla, ln_nea ) 663 664 ENDIF 665 666 ! Feedback SLA data 667 668 IF ( ln_slafb ) THEN 669 670 DO jset = 1, jnumslafb 671 672 nslasets = nslasets + 1 673 674 CALL obs_rea_sla( 0, sladata(nslasets), 1, & 675 & slafbfiles(jset:jset), & 676 & nslavars, nslaextr, nitend-nit000+2, & 677 & dobsini, dobsend, ln_ignmis, .FALSE. ) 678 CALL obs_pre_sla( sladata(nslasets), sladatqc(nslasets), & 679 & ln_sla, ln_nea ) 680 681 END DO 682 683 ENDIF 684 685 CALL obs_rea_mdt( nslasets, sladatqc, n2dint ) 686 687 ! read in altimeter bias 688 689 IF ( ln_altbias ) THEN 690 CALL obs_rea_altbias ( nslasets, sladatqc, n2dint, bias_file ) 691 ENDIF 692 693 ENDIF 694 695 ! - Sea surface height 696 IF ( ln_ssh ) THEN 697 IF(lwp) WRITE(numout,*) ' SSH currently not available' 698 ENDIF 699 700 ! - Sea surface temperature 701 IF ( ln_sst ) THEN 702 703 ! Set the number of variables for sst to 1 704 nsstvars = 1 705 706 ! Set the number of extra variables for sst to 0 707 nsstextr = 0 708 709 nsstsets = 0 710 711 IF (ln_reysst) nsstsets = nsstsets + 1 712 IF (ln_ghrsst) nsstsets = nsstsets + 1 713 IF ( ln_sstfb ) THEN 714 nsstsets = nsstsets + jnumsstfb 715 ENDIF 716 717 ALLOCATE(sstdata(nsstsets)) 718 ALLOCATE(sstdatqc(nsstsets)) 719 ALLOCATE(ld_sstnight(nsstsets)) 720 sstdata(:)%nsurf=0 721 sstdatqc(:)%nsurf=0 722 ld_sstnight(:)=.false. 723 724 nsstsets = 0 725 726 IF (ln_reysst) THEN 727 728 nsstsets = nsstsets + 1 729 730 ld_sstnight(nsstsets) = ln_sstnight 731 732 CALL obs_rea_sst_rey( reysstname, reysstfmt, sstdata(nsstsets), & 733 & nsstvars, nsstextr, & 734 & nitend-nit000+2, dobsini, dobsend ) 735 CALL obs_pre_sst( sstdata(nsstsets), sstdatqc(nsstsets), ln_sst, & 736 & ln_nea ) 737 738 ENDIF 739 740 IF (ln_ghrsst) THEN 741 742 nsstsets = nsstsets + 1 743 744 ld_sstnight(nsstsets) = ln_sstnight 745 746 CALL obs_rea_sst( 1, sstdata(nsstsets), jnumsst, & 747 & sstfiles(1:jnumsst), & 748 & nsstvars, nsstextr, nitend-nit000+2, & 749 & dobsini, dobsend, ln_ignmis, .FALSE. ) 750 CALL obs_pre_sst( sstdata(nsstsets), sstdatqc(nsstsets), ln_sst, & 751 & ln_nea ) 752 753 ENDIF 754 755 ! Feedback SST data 756 757 IF ( ln_sstfb ) THEN 758 759 DO jset = 1, jnumsstfb 760 761 nsstsets = nsstsets + 1 762 763 ld_sstnight(nsstsets) = ln_sstnight 764 765 CALL obs_rea_sst( 0, sstdata(nsstsets), 1, & 766 & sstfbfiles(jset:jset), & 767 & nsstvars, nsstextr, nitend-nit000+2, & 768 & dobsini, dobsend, ln_ignmis, .FALSE. ) 769 CALL obs_pre_sst( sstdata(nsstsets), sstdatqc(nsstsets), & 770 & ln_sst, ln_nea ) 771 772 END DO 773 774 ENDIF 775 776 ENDIF 777 778 ! - Sea surface salinity 779 IF ( ln_sss ) THEN 780 IF(lwp) WRITE(numout,*) ' SSS currently not available' 781 ENDIF 782 783 ! - Sea Ice Concentration 784 785 IF ( ln_seaice ) THEN 786 787 ! Set the number of variables for seaice to 1 788 nseaicevars = 1 789 790 ! Set the number of extra variables for seaice to 0 791 nseaiceextr = 0 792 793 ! Set the number of data sets to 1 794 nseaicesets = 1 795 796 ALLOCATE(seaicedata(nseaicesets)) 797 ALLOCATE(seaicedatqc(nseaicesets)) 798 seaicedata(:)%nsurf=0 799 seaicedatqc(:)%nsurf=0 800 801 CALL obs_rea_seaice( 1, seaicedata(nseaicesets), jnumseaice, & 802 & seaicefiles(1:jnumseaice), & 803 & nseaicevars, nseaiceextr, nitend-nit000+2, & 804 & dobsini, dobsend, ln_ignmis, .FALSE. ) 805 806 CALL obs_pre_seaice( seaicedata(nseaicesets), seaicedatqc(nseaicesets), & 807 & ln_seaice, ln_nea ) 808 809 ENDIF 810 811 IF (ln_vel3d) THEN 812 813 ! Set the number of variables for profiles to 2 (U and V) 814 nvelovars = 2 815 816 ! Set the number of extra variables for profiles to 2 to store 817 ! rotation parameters 818 nveloextr = 2 819 820 jveloset = 0 821 822 IF ( ln_velavcur ) jveloset = jveloset + 1 823 IF ( ln_velhrcur ) jveloset = jveloset + 1 824 IF ( ln_velavadcp ) jveloset = jveloset + 1 825 IF ( ln_velhradcp ) jveloset = jveloset + 1 826 IF (ln_velfb) jveloset = jveloset + jnumvelfb 827 828 nvelosets = jveloset 829 IF ( nvelosets > 0 ) THEN 830 ALLOCATE( velodata(nvelosets) ) 831 ALLOCATE( veldatqc(nvelosets) ) 832 ALLOCATE( ld_velav(nvelosets) ) 833 ENDIF 834 835 jveloset = 0 836 837 ! Daily averaged data 838 839 IF ( ln_velavcur ) THEN 840 841 jveloset = jveloset + 1 842 843 ld_velav(jveloset) = .TRUE. 844 845 CALL obs_rea_vel_dri( 1, velodata(jveloset), jnumvelavcur, & 846 & velavcurfiles(1:jnumvelavcur), & 847 & nvelovars, nveloextr, & 848 & nitend-nit000+2, & 849 & dobsini, dobsend, ln_ignmis, & 850 & ld_velav(jveloset), & 851 & .FALSE. ) 852 853 DO jvar = 1, 2 854 CALL obs_prof_staend( velodata(jveloset), jvar ) 855 END DO 856 857 CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), & 858 & ln_vel3d, ln_nea, ld_velav(jveloset) ) 859 860 ENDIF 861 862 ! High frequency data 863 864 IF ( ln_velhrcur ) THEN 865 866 jveloset = jveloset + 1 867 868 ld_velav(jveloset) = .FALSE. 869 870 CALL obs_rea_vel_dri( 1, velodata(jveloset), jnumvelhrcur, & 871 & velhrcurfiles(1:jnumvelhrcur), & 872 & nvelovars, nveloextr, & 873 & nitend-nit000+2, & 874 & dobsini, dobsend, ln_ignmis, & 875 & ld_velav(jveloset), & 876 & .FALSE. ) 877 878 DO jvar = 1, 2 879 CALL obs_prof_staend( velodata(jveloset), jvar ) 880 END DO 881 882 CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), & 883 & ln_vel3d, ln_nea, ld_velav(jveloset) ) 884 885 ENDIF 886 887 ! Daily averaged data 888 889 IF ( ln_velavadcp ) THEN 890 891 jveloset = jveloset + 1 892 893 ld_velav(jveloset) = .TRUE. 894 895 CALL obs_rea_vel_dri( 1, velodata(jveloset), jnumvelavadcp, & 896 & velavadcpfiles(1:jnumvelavadcp), & 897 & nvelovars, nveloextr, & 898 & nitend-nit000+2, & 899 & dobsini, dobsend, ln_ignmis, & 900 & ld_velav(jveloset), & 901 & .FALSE. ) 902 903 DO jvar = 1, 2 904 CALL obs_prof_staend( velodata(jveloset), jvar ) 905 END DO 906 907 CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), & 908 & ln_vel3d, ln_nea, ld_velav(jveloset) ) 909 910 ENDIF 911 912 ! High frequency data 913 914 IF ( ln_velhradcp ) THEN 915 916 jveloset = jveloset + 1 917 918 ld_velav(jveloset) = .FALSE. 919 920 CALL obs_rea_vel_dri( 1, velodata(jveloset), jnumvelhradcp, & 921 & velhradcpfiles(1:jnumvelhradcp), & 922 & nvelovars, nveloextr, & 923 & nitend-nit000+2, & 924 & dobsini, dobsend, ln_ignmis, & 925 & ld_velav(jveloset), & 926 & .FALSE. ) 927 928 DO jvar = 1, 2 929 CALL obs_prof_staend( velodata(jveloset), jvar ) 930 END DO 931 932 CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), & 933 & ln_vel3d, ln_nea, ld_velav(jveloset) ) 934 935 ENDIF 936 937 IF ( ln_velfb ) THEN 938 939 DO jset = 1, jnumvelfb 940 941 jveloset = jveloset + 1 942 943 ld_velav(jveloset) = ln_velfb_av(jset) 944 945 CALL obs_rea_vel_dri( 0, velodata(jveloset), 1, & 946 & velfbfiles(jset:jset), & 947 & nvelovars, nveloextr, & 948 & nitend-nit000+2, & 949 & dobsini, dobsend, ln_ignmis, & 950 & ld_velav(jveloset), & 951 & .FALSE. ) 952 953 DO jvar = 1, 2 954 CALL obs_prof_staend( velodata(jveloset), jvar ) 955 END DO 956 957 CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), & 958 & ln_vel3d, ln_nea, ld_velav(jveloset) ) 959 960 961 END DO 962 963 ENDIF 964 965 ENDIF 966 370 & kdailyavtypes = dailyavtypes ) 371 372 END DO 373 374 DEALLOCATE( jnumfilesprof, obsfilesprof ) 375 376 ENDIF 377 378 IF ( numsurftypes > 0 ) THEN 379 380 ALLOCATE(surfdata(numsurftypes)) 381 ALLOCATE(surfdatatqc(numsurftypes)) 382 ALLOCATE(nvarssurf(numsurftypes)) 383 ALLOCATE(nextrsurf(numsurftypes)) 384 385 DO jtype = 1, numsurftypes 386 387 nvarssurf(jtype) = 1 388 nextrsurf(jtype) = 0 389 IF ( TRIM(obstypessurf(jtype)) == 'sla' ) nextrsurf(jtype) = 2 390 391 !Read in surface obs types 392 CALL obs_rea_surf( surfdata(jtype), jnumfilessurf(jtype), & 393 & obsfilessurf(jtype,1:jnumfilessurf(jtype)), & 394 & nvarssurf(jtype), nextrsurf(jtype), nitend-nit000+2, & 395 & dobsini, dobsend, ln_ignmis, .FALSE. ) 396 397 CALL obs_pre_surf( surfdata(jtype), surfdataqc(jtype), ln_nea ) 398 399 IF ( TRIM(obstypessurf(jtype)) == 'sla' ) THEN 400 CALL obs_rea_mdt( surfdataqc(jtype), n2dint ) 401 IF ( ln_altbias ) CALL obs_rea_altbias ( surfdataqc(jtype), n2dint, bias_file ) 402 ENDIF 403 404 DEALLOCATE( jnumfilessurf, obsfilessurf ) 405 406 END DO 407 967 408 END SUBROUTINE dia_obs_init 968 409 … … 1017 458 !! * Local declarations 1018 459 INTEGER :: idaystp ! Number of timesteps per day 1019 INTEGER :: jprofset ! Profile data set loop variable 1020 INTEGER :: jslaset ! SLA data set loop variable 1021 INTEGER :: jsstset ! SST data set loop variable 1022 INTEGER :: jseaiceset ! sea ice data set loop variable 1023 INTEGER :: jveloset ! velocity profile data loop variable 460 INTEGER :: jtype ! data loop variable 1024 461 INTEGER :: jvar ! Variable number 1025 462 #if ! defined key_lim2 && ! defined key_lim3 … … 1050 487 !----------------------------------------------------------------------- 1051 488 1052 ! - Temperature/salinity profiles 1053 IF ( ln_t3d .OR. ln_s3d ) THEN 1054 DO jprofset = 1, nprofsets 1055 IF ( ld_enact(jprofset) ) THEN 1056 CALL obs_pro_opt( prodatqc(jprofset), & 1057 & kstp, jpi, jpj, jpk, nit000, idaystp, & 1058 & tsn(:,:,:,jp_tem), tsn(:,:,:,jp_sal), & 1059 & gdept_1d, tmask, n1dint, n2dint, & 1060 & kdailyavtypes = endailyavtypes ) 1061 ELSE 1062 CALL obs_pro_opt( prodatqc(jprofset), & 1063 & kstp, jpi, jpj, jpk, nit000, idaystp, & 1064 & tsn(:,:,:,jp_tem), tsn(:,:,:,jp_sal), & 1065 & gdept_1d, tmask, n1dint, n2dint ) 1066 ENDIF 489 IF ( numproftypes > 0 ) THEN 490 DO jtype = 1, numproftypes 491 492 SELECT CASE ( TRIM(obstypesprof(jtype)) ) 493 CASE('prof') 494 profvar1(:,:,:) = tsn(:,:,:,jp_tem) 495 profvar2(:,:,:) = tsn(:,:,:,jp_sal) 496 profmask1(:,:,:) = tmask(:,:,:) 497 profmask2(:,:,:) = tmask(:,:,:) 498 CASE('vel') 499 profvar1(:,:,:) = un(:,:,:) 500 profvar2(:,:,:) = vn(:,:,:) 501 profmask1(:,:,:) = umask(:,:,:) 502 profmask2(:,:,:) = vmask(:,:,:) 503 END SELECT 504 505 CALL obs_prof_opt( profdataqc(jtype), & 506 & kstp, jpi, jpj, jpk, nit000, idaystp, & 507 & profvar1, profvar2, & 508 & gdept_1d, profmask1, profmask2, n1dint, n2dint, & 509 & kdailyavtypes = dailyavtypes ) 510 1067 511 END DO 1068 ENDIF 1069 1070 ! - Sea surface anomaly 1071 IF ( ln_sla ) THEN 1072 DO jslaset = 1, nslasets 1073 CALL obs_sla_opt( sladatqc(jslaset), & 1074 & kstp, jpi, jpj, nit000, sshn, & 1075 & tmask(:,:,1), n2dint ) 1076 END DO 1077 ENDIF 1078 1079 ! - Sea surface temperature 1080 IF ( ln_sst ) THEN 1081 DO jsstset = 1, nsstsets 1082 CALL obs_sst_opt( sstdatqc(jsstset), & 1083 & kstp, jpi, jpj, nit000, idaystp, & 1084 & tsn(:,:,1,jp_tem), tmask(:,:,1), & 1085 & n2dint, ld_sstnight(jsstset) ) 512 513 ENDIF 514 515 IF ( numsurftypes > 0 ) THEN 516 DO jtype = 1, numsurftypes 517 518 SELECT CASE ( TRIM(obstypessurf(jtype)) ) 519 CASE('sst') 520 surfvar(:,:) = tsn(:,:,1,jp_tem) 521 CASE('sla') 522 surfvar(:,:) = sshn(:,:) 523 CASE('sss') 524 surfvar(:,:) = tsn(:,:,1,jp_sal) 525 #if defined key_lim2 || defined key_lim3 526 CASE('seaice') 527 surfvar(:,:) = 1._wp - frld(:,:) 528 #endif 529 END SELECT 530 531 CALL obs_surf_opt( surfdatqc(jtype), & 532 & kstp, jpi, jpj, nit000, surfvar, & 533 & tmask(:,:,1), n2dint, ld_sstnight ) 534 1086 535 END DO 1087 ENDIF 1088 1089 ! - Sea surface salinity 1090 IF ( ln_sss ) THEN 1091 IF(lwp) WRITE(numout,*) ' SSS currently not available' 1092 ENDIF 1093 1094 #if defined key_lim2 || defined key_lim3 1095 IF ( ln_seaice ) THEN 1096 DO jseaiceset = 1, nseaicesets 1097 CALL obs_seaice_opt( seaicedatqc(jseaiceset), & 1098 & kstp, jpi, jpj, nit000, 1.-frld, & 1099 & tmask(:,:,1), n2dint ) 1100 END DO 1101 ENDIF 1102 #endif 1103 1104 ! - Velocity profiles 1105 IF ( ln_vel3d ) THEN 1106 DO jveloset = 1, nvelosets 1107 ! zonal component of velocity 1108 CALL obs_vel_opt( veldatqc(jveloset), kstp, jpi, jpj, jpk, & 1109 & nit000, idaystp, un, vn, gdept_1d, umask, vmask, & 1110 n1dint, n2dint, ld_velav(jveloset) ) 1111 END DO 1112 ENDIF 1113 536 537 ENDIF 538 1114 539 #if ! defined key_lim2 && ! defined key_lim3 1115 540 CALL wrk_dealloc(jpi,jpj,frld) … … 1139 564 !! * Local declarations 1140 565 1141 INTEGER :: jprofset ! Profile data set loop variable 1142 INTEGER :: jveloset ! Velocity data set loop variable 1143 INTEGER :: jslaset ! SLA data set loop variable 1144 INTEGER :: jsstset ! SST data set loop variable 1145 INTEGER :: jseaiceset ! Sea Ice data set loop variable 1146 INTEGER :: jset 1147 INTEGER :: jfbini 1148 CHARACTER(LEN=20) :: datestr=" ",timestr=" " 1149 CHARACTER(LEN=10) :: cdtmp 566 INTEGER :: jtype ! Data set loop variable 1150 567 !----------------------------------------------------------------------- 1151 568 ! Depending on switches call various observation output routines 1152 569 !----------------------------------------------------------------------- 1153 570 1154 ! - Temperature/salinity profiles 1155 1156 IF( ln_t3d .OR. ln_s3d ) THEN 1157 1158 ! Copy data from prodatqc to profdata structures 1159 DO jprofset = 1, nprofsets 1160 1161 CALL obs_prof_decompress( prodatqc(jprofset), & 1162 & profdata(jprofset), .TRUE., numout ) 1163 571 IF ( numproftypes > 0 ) THEN 572 DO jtype = 1, numproftypes 573 574 CALL obs_prof_decompress( profdataqc(jtype), & 575 & profdata(jtype), .TRUE., numout ) 576 577 CALL obs_wri_prof( obstypesprof(jtype), profdata(jtype), n2dint ) 578 1164 579 END DO 1165 1166 ! Write the profiles. 1167 1168 jprofset = 0 1169 1170 ! ENACT insitu data 1171 1172 IF ( ln_ena ) THEN 1173 1174 jprofset = jprofset + 1 1175 1176 CALL obs_wri_p3d( 'enact', profdata(jprofset) ) 1177 1178 ENDIF 1179 1180 ! Coriolis insitu data 1181 1182 IF ( ln_cor ) THEN 1183 1184 jprofset = jprofset + 1 1185 1186 CALL obs_wri_p3d( 'corio', profdata(jprofset) ) 1187 1188 ENDIF 1189 1190 ! Feedback insitu data 1191 1192 IF ( ln_profb ) THEN 1193 1194 jfbini = jprofset + 1 1195 1196 DO jprofset = jfbini, nprofsets 1197 1198 jset = jprofset - jfbini + 1 1199 WRITE(cdtmp,'(A,I2.2)')'profb_',jset 1200 CALL obs_wri_p3d( cdtmp, profdata(jprofset) ) 1201 1202 END DO 1203 1204 ENDIF 1205 1206 ENDIF 1207 1208 ! - Sea surface anomaly 1209 IF ( ln_sla ) THEN 1210 1211 ! Copy data from sladatqc to sladata structures 1212 DO jslaset = 1, nslasets 1213 1214 CALL obs_surf_decompress( sladatqc(jslaset), & 1215 & sladata(jslaset), .TRUE., numout ) 580 581 ENDIF 582 583 IF ( numsurftypes > 0 ) THEN 584 DO jtype = 1, numsurftypes 585 586 CALL obs_surf_decompress( surfdatqc(jtype), & 587 & surfdata(jtype), .TRUE., numout ) 588 589 CALL obs_wri_surf( obstypessurf(jtype), surfdata(jtype), n2dint ) 1216 590 1217 591 END DO 1218 1219 jslaset = 0 1220 1221 ! Write the AVISO SLA data 1222 1223 IF ( ln_sladt ) THEN 1224 1225 jslaset = 1 1226 CALL obs_wri_sla( 'aviso_act', sladata(jslaset) ) 1227 jslaset = 2 1228 CALL obs_wri_sla( 'aviso_pas', sladata(jslaset) ) 1229 1230 ENDIF 1231 1232 IF ( ln_slafb ) THEN 1233 1234 jfbini = jslaset + 1 1235 1236 DO jslaset = jfbini, nslasets 1237 1238 jset = jslaset - jfbini + 1 1239 WRITE(cdtmp,'(A,I2.2)')'slafb_',jset 1240 CALL obs_wri_sla( cdtmp, sladata(jslaset) ) 1241 1242 END DO 1243 1244 ENDIF 1245 1246 ENDIF 1247 1248 ! - Sea surface temperature 1249 IF ( ln_sst ) THEN 1250 1251 ! Copy data from sstdatqc to sstdata structures 1252 DO jsstset = 1, nsstsets 1253 1254 CALL obs_surf_decompress( sstdatqc(jsstset), & 1255 & sstdata(jsstset), .TRUE., numout ) 1256 1257 END DO 1258 1259 jsstset = 0 1260 1261 ! Write the AVISO SST data 1262 1263 IF ( ln_reysst ) THEN 1264 1265 jsstset = jsstset + 1 1266 CALL obs_wri_sst( 'reynolds', sstdata(jsstset) ) 1267 1268 ENDIF 1269 1270 IF ( ln_ghrsst ) THEN 1271 1272 jsstset = jsstset + 1 1273 CALL obs_wri_sst( 'ghr', sstdata(jsstset) ) 1274 1275 ENDIF 1276 1277 IF ( ln_sstfb ) THEN 1278 1279 jfbini = jsstset + 1 1280 1281 DO jsstset = jfbini, nsstsets 1282 1283 jset = jsstset - jfbini + 1 1284 WRITE(cdtmp,'(A,I2.2)')'sstfb_',jset 1285 CALL obs_wri_sst( cdtmp, sstdata(jsstset) ) 1286 1287 END DO 1288 1289 ENDIF 1290 1291 ENDIF 1292 1293 ! - Sea surface salinity 1294 IF ( ln_sss ) THEN 1295 IF(lwp) WRITE(numout,*) ' SSS currently not available' 1296 ENDIF 1297 1298 ! - Sea Ice Concentration 1299 IF ( ln_seaice ) THEN 1300 1301 ! Copy data from seaicedatqc to seaicedata structures 1302 DO jseaiceset = 1, nseaicesets 1303 1304 CALL obs_surf_decompress( seaicedatqc(jseaiceset), & 1305 & seaicedata(jseaiceset), .TRUE., numout ) 1306 1307 END DO 1308 1309 ! Write the Sea Ice data 1310 DO jseaiceset = 1, nseaicesets 1311 1312 WRITE(cdtmp,'(A,I2.2)')'seaicefb_',jseaiceset 1313 CALL obs_wri_seaice( cdtmp, seaicedata(jseaiceset) ) 1314 1315 END DO 1316 1317 ENDIF 1318 1319 ! Velocity data 1320 IF( ln_vel3d ) THEN 1321 1322 ! Copy data from veldatqc to velodata structures 1323 DO jveloset = 1, nvelosets 1324 1325 CALL obs_prof_decompress( veldatqc(jveloset), & 1326 & velodata(jveloset), .TRUE., numout ) 1327 1328 END DO 1329 1330 ! Write the profiles. 1331 1332 jveloset = 0 1333 1334 ! Daily averaged data 1335 1336 IF ( ln_velavcur ) THEN 1337 1338 jveloset = jveloset + 1 1339 1340 CALL obs_wri_vel( 'velavcurr', velodata(jveloset), n2dint ) 1341 1342 ENDIF 1343 1344 ! High frequency data 1345 1346 IF ( ln_velhrcur ) THEN 1347 1348 jveloset = jveloset + 1 1349 1350 CALL obs_wri_vel( 'velhrcurr', velodata(jveloset), n2dint ) 1351 1352 ENDIF 1353 1354 ! Daily averaged data 1355 1356 IF ( ln_velavadcp ) THEN 1357 1358 jveloset = jveloset + 1 1359 1360 CALL obs_wri_vel( 'velavadcp', velodata(jveloset), n2dint ) 1361 1362 ENDIF 1363 1364 ! High frequency data 1365 1366 IF ( ln_velhradcp ) THEN 1367 1368 jveloset = jveloset + 1 1369 1370 CALL obs_wri_vel( 'velhradcp', velodata(jveloset), n2dint ) 1371 1372 ENDIF 1373 1374 ! Feedback velocity data 1375 1376 IF ( ln_velfb ) THEN 1377 1378 jfbini = jveloset + 1 1379 1380 DO jveloset = jfbini, nvelosets 1381 1382 jset = jveloset - jfbini + 1 1383 WRITE(cdtmp,'(A,I2.2)')'velfb_',jset 1384 CALL obs_wri_vel( cdtmp, velodata(jveloset), n2dint ) 1385 1386 END DO 1387 1388 ENDIF 1389 1390 ENDIF 592 593 ENDIF 594 1391 595 1392 596 END SUBROUTINE dia_obs_wri … … 1409 613 1410 614 !! diaobs deallocation 1411 IF ( nprofsets > 0 ) THEN 1412 DEALLOCATE(ld_enact, & 1413 & profdata, & 1414 & prodatqc) 1415 END IF 1416 IF ( ln_sla ) THEN 1417 DEALLOCATE(sladata, & 1418 & sladatqc) 1419 END IF 1420 IF ( ln_seaice ) THEN 1421 DEALLOCATE(sladata, & 1422 & sladatqc) 1423 END IF 1424 IF ( ln_sst ) THEN 1425 DEALLOCATE(sstdata, & 1426 & sstdatqc) 1427 END IF 1428 IF ( ln_vel3d ) THEN 1429 DEALLOCATE(ld_velav, & 1430 & velodata, & 1431 & veldatqc) 1432 END IF 615 IF ( numproftypes > 0 ) DEALLOCATE(profdata, profdataqc, nvarsprof, nextrprof) 616 IF ( numsurftypes > 0 ) DEALLOCATE(surfdata, surfdataqc, nvarssurf, nextrsurf) 617 1433 618 END SUBROUTINE dia_obs_dealloc 1434 619
Note: See TracChangeset
for help on using the changeset viewer.