Changeset 2074
- Timestamp:
- 2010-09-08T16:59:58+02:00 (14 years ago)
- Location:
- branches/dev_1784_OBS/NEMO/OPA_SRC/OBS
- Files:
-
- 40 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/ddatetoymdhms.h90
r2001 r2074 15 15 16 16 !! * Arguments 17 REAL(dp), INTENT(IN) :: & 18 & ddate 19 INTEGER, INTENT(OUT) :: & 20 & kyea, & 21 & kmon, & 22 & kday, & 23 & khou, & 24 & kmin, & 25 & ksec 17 REAL(dp), INTENT(IN) :: ddate 18 INTEGER, INTENT(OUT) :: kyea 19 INTEGER, INTENT(OUT) :: kmon 20 INTEGER, INTENT(OUT) :: kday 21 INTEGER, INTENT(OUT) :: khou 22 INTEGER, INTENT(OUT) :: kmin 23 INTEGER, INTENT(OUT) :: ksec 26 24 !! * Local declarations 27 INTEGER :: & 28 & iyymmdd, & 29 & ihhmmss 25 INTEGER :: iyymmdd 26 INTEGER :: ihhmmss 30 27 31 28 iyymmdd = INT( ddate ) -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/diaobs.F90
r2001 r2074 57 57 58 58 !! * Module variables 59 LOGICAL, PUBLIC :: & 60 & ln_t3d, & !: Logical switch for temperature profiles 61 & ln_s3d, & !: Logical switch for salinity profiles 62 & ln_ena, & !: Logical switch for the ENACT data set 63 & ln_cor, & !: Logical switch for the Coriolis data set 64 & ln_profb, & !: Logical switch for profile feedback datafiles 65 & ln_sla, & !: Logical switch for sea level anomalies 66 & ln_sladt, & !: Logical switch for SLA from AVISO files 67 & ln_slafb, & !: Logical switch for SLA from feedback files 68 & ln_sst, & !: Logical switch for sea surface temperature 69 & ln_reysst, & !: Logical switch for Reynolds sea surface temperature 70 & ln_ghrsst, & !: Logical switch for GHRSST data 71 & ln_sstfb, & !: Logical switch for SST from feedback files 72 & ln_seaice, & !: Logical switch for sea ice concentration 73 & ln_vel3d, & !: Logical switch for velocity component (u,v) observations 74 & ln_velavcur, & !: Logical switch for raw daily averaged netCDF current meter vel. data 75 & ln_velhrcur, & !: Logical switch for raw high freq netCDF current meter vel. data 76 & ln_velavadcp, & !: Logical switch for raw daily averaged netCDF ADCP vel. data 77 & ln_velhradcp, & !: Logical switch for raw high freq netCDF ADCP vel. data 78 & ln_velfb, & !: Logical switch for velocities from feedback files 79 & ln_ssh, & !: Logical switch for sea surface height 80 & ln_sss, & !: Logical switch for sea surface salinity 81 & ln_nea, & !: Remove observations near land 82 & ln_altbias,& !: Logical switch for altimeter bias 83 & ln_ignmis, & !: Logical switch for ignoring missing files 84 & ln_s_at_t !: Logical switch to compute model S at T observations 85 86 REAL(KIND=dp), PUBLIC :: & 87 & dobsini, & !: Observation window start date YYYYMMDD.HHMMSS 88 & dobsend !: Observation window end date YYYYMMDD.HHMMSS 59 LOGICAL, PUBLIC :: ln_t3d !: Logical switch for temperature profiles 60 LOGICAL, PUBLIC :: ln_s3d !: Logical switch for salinity profiles 61 LOGICAL, PUBLIC :: ln_ena !: Logical switch for the ENACT data set 62 LOGICAL, PUBLIC :: ln_cor !: Logical switch for the Coriolis data set 63 LOGICAL, PUBLIC :: ln_profb !: Logical switch for profile feedback datafiles 64 LOGICAL, PUBLIC :: ln_sla !: Logical switch for sea level anomalies 65 LOGICAL, PUBLIC :: ln_sladt !: Logical switch for SLA from AVISO files 66 LOGICAL, PUBLIC :: ln_slafb !: Logical switch for SLA from feedback files 67 LOGICAL, PUBLIC :: ln_sst !: Logical switch for sea surface temperature 68 LOGICAL, PUBLIC :: ln_reysst !: Logical switch for Reynolds sea surface temperature 69 LOGICAL, PUBLIC :: ln_ghrsst !: Logical switch for GHRSST data 70 LOGICAL, PUBLIC :: ln_sstfb !: Logical switch for SST from feedback files 71 LOGICAL, PUBLIC :: ln_seaice !: Logical switch for sea ice concentration 72 LOGICAL, PUBLIC :: ln_vel3d !: Logical switch for velocity component (u,v) observations 73 LOGICAL, PUBLIC :: ln_velavcur !: Logical switch for raw daily averaged netCDF current meter vel. data 74 LOGICAL, PUBLIC :: ln_velhrcur !: Logical switch for raw high freq netCDF current meter vel. data 75 LOGICAL, PUBLIC :: ln_velavadcp !: Logical switch for raw daily averaged netCDF ADCP vel. data 76 LOGICAL, PUBLIC :: ln_velhradcp !: Logical switch for raw high freq netCDF ADCP vel. data 77 LOGICAL, PUBLIC :: ln_velfb !: Logical switch for velocities from feedback files 78 LOGICAL, PUBLIC :: ln_ssh !: Logical switch for sea surface height 79 LOGICAL, PUBLIC :: ln_sss !: Logical switch for sea surface salinity 80 LOGICAL, PUBLIC :: ln_nea !: Remove observations near land 81 LOGICAL, PUBLIC :: ln_altbias !: Logical switch for altimeter bias 82 LOGICAL, PUBLIC :: ln_ignmis !: Logical switch for ignoring missing files 83 LOGICAL, PUBLIC :: ln_s_at_t !: Logical switch to compute model S at T observations 84 85 REAL(KIND=dp), PUBLIC :: dobsini !: Observation window start date YYYYMMDD.HHMMSS 86 REAL(KIND=dp), PUBLIC :: dobsend !: Observation window end date YYYYMMDD.HHMMSS 89 87 90 INTEGER, PUBLIC :: & 91 & n1dint, & !: Vertical interpolation method 92 & n2dint !: Horizontal interpolation method 88 INTEGER, PUBLIC :: n1dint !: Vertical interpolation method 89 INTEGER, PUBLIC :: n2dint !: Horizontal interpolation method 93 90 94 91 INTEGER, DIMENSION(imaxavtypes) :: & … … 170 167 & ln_velfb, velfbfiles, ln_velfb_av, & 171 168 & ln_profb_enatim, ln_ignmis 172 INTEGER :: & 173 & jprofset, &174 & jveloset, &175 & jvar, &176 & jnumenact, &177 & jnumcorio, &178 & jnumprofb, &179 & jnumslaact, &180 & jnumslapas, &181 & jnumslafb, &182 & jnumsst, &183 & jnumsstfb, &184 & jnumseaice, &185 & jnumvelavcur, &186 & jnumvelhrcur, &187 & jnumvelavadcp, &188 & jnumvelhradcp, &189 & jnumvelfb, &190 & ji, &191 &jset169 170 INTEGER :: jprofset 171 INTEGER :: jveloset 172 INTEGER :: jvar 173 INTEGER :: jnumenact 174 INTEGER :: jnumcorio 175 INTEGER :: jnumprofb 176 INTEGER :: jnumslaact 177 INTEGER :: jnumslapas 178 INTEGER :: jnumslafb 179 INTEGER :: jnumsst 180 INTEGER :: jnumsstfb 181 INTEGER :: jnumseaice 182 INTEGER :: jnumvelavcur 183 INTEGER :: jnumvelhrcur 184 INTEGER :: jnumvelavadcp 185 INTEGER :: jnumvelhradcp 186 INTEGER :: jnumvelfb 187 INTEGER :: ji 188 INTEGER :: jset 192 189 LOGICAL :: lmask(MaxNumFiles), ll_u3d, ll_v3d 193 190 … … 263 260 WHERE (enactfiles(:) /= '') lmask(:) = .TRUE. 264 261 jnumenact = COUNT(lmask) 265 END 262 ENDIF 266 263 IF (ln_cor) THEN 267 264 lmask(:) = .FALSE. 268 265 WHERE (coriofiles(:) /= '') lmask(:) = .TRUE. 269 266 jnumcorio = COUNT(lmask) 270 END 267 ENDIF 271 268 IF (ln_profb) THEN 272 269 lmask(:) = .FALSE. 273 270 WHERE (profbfiles(:) /= '') lmask(:) = .TRUE. 274 271 jnumprofb = COUNT(lmask) 275 END 272 ENDIF 276 273 IF (ln_sladt) THEN 277 274 lmask(:) = .FALSE. … … 281 278 WHERE (slafilespas(:) /= '') lmask(:) = .TRUE. 282 279 jnumslapas = COUNT(lmask) 283 END 280 ENDIF 284 281 IF (ln_slafb) THEN 285 282 lmask(:) = .FALSE. … … 287 284 jnumslafb = COUNT(lmask) 288 285 lmask(:) = .FALSE. 289 END 286 ENDIF 290 287 IF (ln_ghrsst) THEN 291 288 lmask(:) = .FALSE. 292 289 WHERE (sstfiles(:) /= '') lmask(:) = .TRUE. 293 290 jnumsst = COUNT(lmask) 294 END 291 ENDIF 295 292 IF (ln_sstfb) THEN 296 293 lmask(:) = .FALSE. … … 298 295 jnumsstfb = COUNT(lmask) 299 296 lmask(:) = .FALSE. 300 END 297 ENDIF 301 298 IF (ln_seaice) THEN 302 299 lmask(:) = .FALSE. 303 300 WHERE (seaicefiles(:) /= '') lmask(:) = .TRUE. 304 301 jnumseaice = COUNT(lmask) 305 END 302 ENDIF 306 303 IF (ln_velavcur) THEN 307 304 lmask(:) = .FALSE. 308 305 WHERE (velavcurfiles(:) /= '') lmask(:) = .TRUE. 309 306 jnumvelavcur = COUNT(lmask) 310 END 307 ENDIF 311 308 IF (ln_velhrcur) THEN 312 309 lmask(:) = .FALSE. 313 310 WHERE (velhrcurfiles(:) /= '') lmask(:) = .TRUE. 314 311 jnumvelhrcur = COUNT(lmask) 315 END 312 ENDIF 316 313 IF (ln_velavadcp) THEN 317 314 lmask(:) = .FALSE. 318 315 WHERE (velavadcpfiles(:) /= '') lmask(:) = .TRUE. 319 316 jnumvelavadcp = COUNT(lmask) 320 END 317 ENDIF 321 318 IF (ln_velhradcp) THEN 322 319 lmask(:) = .FALSE. 323 320 WHERE (velhradcpfiles(:) /= '') lmask(:) = .TRUE. 324 321 jnumvelhradcp = COUNT(lmask) 325 END 322 ENDIF 326 323 IF (ln_velfb) THEN 327 324 lmask(:) = .FALSE. … … 329 326 jnumvelfb = COUNT(lmask) 330 327 lmask(:) = .FALSE. 331 END 328 ENDIF 332 329 333 330 ! Control print … … 372 369 TRIM(enactfiles(ji)) 373 370 END DO 374 END 371 ENDIF 375 372 IF (ln_cor) THEN 376 373 DO ji = 1, jnumcorio … … 378 375 TRIM(coriofiles(ji)) 379 376 END DO 380 END 377 ENDIF 381 378 IF (ln_profb) THEN 382 379 DO ji = 1, jnumprofb … … 390 387 WRITE(numout,'(1X,2A)') ' Enact feedback input time setting switch ln_profb_enatim = ', ln_profb_enatim(ji) 391 388 END DO 392 END 389 ENDIF 393 390 IF (ln_sladt) THEN 394 391 DO ji = 1, jnumslaact … … 400 397 TRIM(slafilespas(ji)) 401 398 END DO 402 END 399 ENDIF 403 400 IF (ln_slafb) THEN 404 401 DO ji = 1, jnumslafb … … 406 403 TRIM(slafbfiles(ji)) 407 404 END DO 408 END 405 ENDIF 409 406 IF (ln_ghrsst) THEN 410 407 DO ji = 1, jnumsst … … 412 409 TRIM(sstfiles(ji)) 413 410 END DO 414 END 411 ENDIF 415 412 IF (ln_sstfb) THEN 416 413 DO ji = 1, jnumsstfb … … 418 415 TRIM(sstfbfiles(ji)) 419 416 END DO 420 END 417 ENDIF 421 418 IF (ln_seaice) THEN 422 419 DO ji = 1, jnumseaice … … 424 421 TRIM(seaicefiles(ji)) 425 422 END DO 426 END 423 ENDIF 427 424 IF (ln_velavcur) THEN 428 425 DO ji = 1, jnumvelavcur … … 430 427 TRIM(velavcurfiles(ji)) 431 428 END DO 432 END 429 ENDIF 433 430 IF (ln_velhrcur) THEN 434 431 DO ji = 1, jnumvelhrcur … … 436 433 TRIM(velhrcurfiles(ji)) 437 434 END DO 438 END 435 ENDIF 439 436 IF (ln_velavadcp) THEN 440 437 DO ji = 1, jnumvelavadcp … … 442 439 TRIM(velavadcpfiles(ji)) 443 440 END DO 444 END 441 ENDIF 445 442 IF (ln_velhradcp) THEN 446 443 DO ji = 1, jnumvelhradcp … … 448 445 TRIM(velhradcpfiles(ji)) 449 446 END DO 450 END 447 ENDIF 451 448 IF (ln_velfb) THEN 452 449 DO ji = 1, jnumvelfb … … 459 456 ENDIF 460 457 END DO 461 END 458 ENDIF 462 459 WRITE(numout,*) ' Initial date in window YYYYMMDD.HHMMSS dobsini = ', dobsini 463 460 WRITE(numout,*) ' Final date in window YYYYMMDD.HHMMSS dobsend = ', dobsend … … 630 627 ENDIF 631 628 632 END DO629 END DO 633 630 634 631 ENDIF … … 734 731 & ln_sla, ln_nea ) 735 732 736 END DO733 END DO 737 734 738 735 ENDIF … … 841 838 & ln_sst, ln_nea ) 842 839 843 END DO840 END DO 844 841 845 842 ENDIF … … 869 866 nseaiceextr = 0 870 867 871 ! Set the number of sladata sets to 1868 ! Set the number of data sets to 1 872 869 nseaicesets = 1 873 870 … … 1044 1041 1045 1042 1046 END DO1043 END DO 1047 1044 1048 1045 ENDIF … … 1104 1101 1105 1102 !! * Arguments 1106 INTEGER, INTENT(IN) :: & 1107 & kstp ! Current timestep 1103 INTEGER, INTENT(IN) :: kstp ! Current timestep 1108 1104 !! * Local declarations 1109 1105 #if ! defined key_ice_lim 1110 REAL(wp), DIMENSION(jpi,jpj) :: & 1111 & frld 1112 #endif 1113 INTEGER :: & 1114 & idaystp, & ! Number of timesteps per day 1115 & jprofset, & ! Profile data set loop variable 1116 & jslaset, & ! SLA data set loop variable 1117 & jsstset, & ! SST data set loop variable 1118 & jseaiceset, & ! sea ice data set loop variable 1119 & jveloset, & ! velocity profile data loop variable 1120 & jvar ! Variable number 1106 REAL(wp), DIMENSION(jpi,jpj) :: frld 1107 #endif 1108 INTEGER :: idaystp ! Number of timesteps per day 1109 INTEGER :: jprofset ! Profile data set loop variable 1110 INTEGER :: jslaset ! SLA data set loop variable 1111 INTEGER :: jsstset ! SST data set loop variable 1112 INTEGER :: jseaiceset ! sea ice data set loop variable 1113 INTEGER :: jveloset ! velocity profile data loop variable 1114 INTEGER :: jvar ! Variable number 1121 1115 CHARACTER(LEN=20) :: datestr=" ",timestr=" " 1122 1116 … … 1231 1225 1232 1226 !! * Local declarations 1233 INTEGER :: & 1234 & jprofset, & ! Profile data set loop variable 1235 & jveloset, & ! Velocity data set loop variable 1236 & jslaset, & ! SLA data set loop variable 1237 & jsstset, & ! SST data set loop variable 1238 & jseaiceset ! Sea Ice data set loop variable 1239 INTEGER :: & 1240 & jset, & 1241 & jfbini 1227 1228 INTEGER :: jprofset ! Profile data set loop variable 1229 INTEGER :: jveloset ! Velocity data set loop variable 1230 INTEGER :: jslaset ! SLA data set loop variable 1231 INTEGER :: jsstset ! SST data set loop variable 1232 INTEGER :: jseaiceset ! Sea Ice data set loop variable 1233 INTEGER :: jset 1234 INTEGER :: jfbini 1242 1235 CHARACTER(LEN=20) :: datestr=" ",timestr=" " 1243 1236 CHARACTER(LEN=10) :: cdtmp … … 1302 1295 CALL obs_wri_p3d( cdtmp, profdata(jprofset) ) 1303 1296 1304 END DO1297 END DO 1305 1298 1306 1299 ENDIF … … 1342 1335 CALL obs_wri_sla( cdtmp, sladata(jslaset) ) 1343 1336 1344 END DO1337 END DO 1345 1338 1346 1339 ENDIF … … 1387 1380 CALL obs_wri_sst( cdtmp, sstdata(jsstset) ) 1388 1381 1389 END DO1382 END DO 1390 1383 1391 1384 ENDIF … … 1486 1479 CALL obs_wri_vel( cdtmp, velodata(jveloset), n2dint ) 1487 1480 1488 END DO1481 END DO 1489 1482 1490 1483 ENDIF … … 1528 1521 1529 1522 !! * Arguments 1530 REAL(KIND=dp), INTENT(OUT) :: & 1531 & ddobsini ! Initial date in YYYYMMDD.HHMMSS 1523 REAL(KIND=dp), INTENT(OUT) :: ddobsini ! Initial date in YYYYMMDD.HHMMSS 1532 1524 1533 1525 !! * Local declarations 1534 INTEGER :: & ! date 1535 & iyea, & ! - (year, month, day, hour, minute) 1536 & imon, & 1537 & iday, & 1538 & ihou, & 1539 & imin 1526 INTEGER :: iyea ! date - (year, month, day, hour, minute) 1527 INTEGER :: imon 1528 INTEGER :: iday 1529 INTEGER :: ihou 1530 INTEGER :: imin 1540 1531 INTEGER :: imday ! Number of days in month. 1541 1532 REAL(KIND=wp) :: zdayfrc ! Fraction of day … … 1613 1604 1614 1605 !! * Arguments 1615 REAL(KIND=dp), INTENT(OUT) :: & 1616 & ddobsfin ! Final date in YYYYMMDD.HHMMSS 1606 REAL(KIND=dp), INTENT(OUT) :: ddobsfin ! Final date in YYYYMMDD.HHMMSS 1617 1607 1618 1608 !! * Local declarations 1619 INTEGER :: & ! Date 1620 & iyea, & ! - (year, month, day, hour, minute) 1621 & imon, & 1622 & iday, & 1623 & ihou, & 1624 & imin 1625 INTEGER :: & 1626 & imday ! Number of days in month 1627 REAL(KIND=wp) :: & 1628 & zdayfrc ! Fraction of day 1609 INTEGER :: iyea ! date - (year, month, day, hour, minute) 1610 INTEGER :: imon 1611 INTEGER :: iday 1612 INTEGER :: ihou 1613 INTEGER :: imin 1614 INTEGER :: imday ! Number of days in month. 1615 REAL(KIND=wp) :: zdayfrc ! Fraction of day 1629 1616 1630 1617 INTEGER, DIMENSION(12) :: imonth_len !: length in days of the months of the current year -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/find_obs_proc.h90
r2001 r2074 16 16 17 17 !! * Arguments 18 INTEGER, INTENT(IN) :: & 19 & kldi, & ! Start of inner domain in i 20 & klei, & ! End of inner domain in i 21 & kldj, & ! Start of inner domain in j 22 & klej ! End of inner domain in j 23 INTEGER, INTENT(IN) :: & 24 & kmyproc, & 25 & kno 26 INTEGER, DIMENSION(kno), INTENT(IN) :: & 27 & kobsi, & 28 & kobsj 29 INTEGER, DIMENSION(kno), INTENT(INOUT) :: & 30 & kobsp 18 19 INTEGER, INTENT(IN) :: kldi ! Start of inner domain in i 20 INTEGER, INTENT(IN) :: klei ! End of inner domain in i 21 INTEGER, INTENT(IN) :: kldj ! Start of inner domain in j 22 INTEGER, INTENT(IN) :: klej ! End of inner domain in j 23 24 INTEGER, INTENT(IN) :: kmyproc 25 INTEGER, INTENT(IN) :: kno 26 27 INTEGER, DIMENSION(kno), INTENT(IN) :: kobsi 28 INTEGER, DIMENSION(kno), INTENT(IN) :: kobsj 29 INTEGER, DIMENSION(kno), INTENT(INOUT) :: kobsp 31 30 32 31 !! * local variables … … 47 46 kobsp(ji)=1000000 48 47 ENDIF 49 END DO48 END DO 50 49 51 50 ! Ensure that observations not in processor are masked -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/grt_cir_dis.h90
r2001 r2074 15 15 16 16 !! * Arguments 17 REAL(KIND=wp) ::& 18 & pa1, & ! sin(lat1) 19 & pa2, & ! sin(lat2) 20 & pb1, & ! cos(lat1) * cos(lon1) 21 & pb2, & ! cos(lat2) * cos(lon2) 22 & pc1, & ! cos(lat1) * sin(lon1) 23 & pc2 ! cos(lat2) * sin(lon2) 17 REAL(KIND=wp) :: pa1 ! sin(lat1) 18 REAL(KIND=wp) :: pa2 ! sin(lat2) 19 REAL(KIND=wp) :: pb1 ! cos(lat1) * cos(lon1) 20 REAL(KIND=wp) :: pb2 ! cos(lat2) * cos(lon2) 21 REAL(KIND=wp) :: pc1 ! cos(lat1) * sin(lon1) 22 REAL(KIND=wp) :: pc2 ! cos(lat2) * sin(lon2) 24 23 25 24 grt_cir_dis = & -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/grt_cir_dis_saa.h90
r2001 r2074 17 17 18 18 !! * Arguments 19 REAL(KIND=wp) :: & 20 & pa, & ! lon1 - lon2 21 & pb, & ! lat1 - lat2 22 & pc ! cos(lat2) 19 REAL(KIND=wp) :: pa ! lon1 - lon2 20 REAL(KIND=wp) :: pb ! lat1 - lat2 21 REAL(KIND=wp) :: pc ! cos(lat2) 23 22 24 23 grt_cir_dis_saa = SQRT( pa * pa + ( pb * pc )**2 ) -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/linquad.h90
r2001 r2074 18 18 19 19 !! * Arguments 20 REAL(KIND=wp), INTENT(IN) :: & 21 & px, & ! (lon, lat) of the point P(x,y) 22 & py 20 REAL(KIND=wp), INTENT(IN) :: px ! (lon) of the point P(x,y) 21 REAL(KIND=wp), INTENT(IN) :: py ! (lat) of the point P(x,y) 23 22 REAL(KIND=wp), DIMENSION(4), INTENT(IN) :: & 24 23 & pxv, & ! (lon, lat) of the surrounding cell … … 26 25 27 26 !! * Local declarations 28 REAL(KIND=wp) :: & 29 & zst1, & 30 & zst2, & 31 & zst3, & 32 & zst4 27 REAL(KIND=wp) :: zst1 28 REAL(KIND=wp) :: zst2 29 REAL(KIND=wp) :: zst3 30 REAL(KIND=wp) :: zst4 33 31 34 32 !----------------------------------------------------------------------- -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/maxdist.h90
r2001 r2074 27 27 & zb, & 28 28 & zc 29 REAL(KIND=wp) :: & 30 & zdist 31 INTEGER :: & 32 & ji, & 33 & jj 29 REAL(KIND=wp) :: zdist 30 31 INTEGER :: ji 32 INTEGER :: jj 34 33 35 34 !----------------------------------------------------------------------- -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/mpp_map.F90
r2001 r2074 63 63 64 64 !! * Arguments 65 INTEGER, DIMENSION(:,:), ALLOCATABLE :: & 66 & imppmap 65 INTEGER, DIMENSION(:,:), ALLOCATABLE :: imppmap 67 66 #if defined key_mpp_mpi 68 67 !! * Local declarations 69 INTEGER :: & 70 & ierr 68 INTEGER :: ierr 71 69 # include <mpif.h> 72 70 #endif -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_conv.h90
r2001 r2074 23 23 24 24 !! * Arguments 25 REAL(KIND=wp), INTENT(IN) :: & 26 & ps, & 27 & pt, & 28 & pp, & 29 & ppr 30 31 !! * Local declarations 32 REAL(KIND=wp) :: & 33 & zpol 34 REAL(KIND=wp), PARAMETER :: & 35 & a1 = 1.067610e-05, & 36 & a2 = -1.434297e-06, & 37 & a3 = -7.566349e-09, & 38 & a4 = -8.535585e-06, & 39 & a5 = 3.074672e-08, & 40 & a6 = 1.918639e-08, & 41 & a7 = 1.788718e-10 25 26 REAL(KIND=wp), INTENT(IN) :: ps 27 REAL(KIND=wp), INTENT(IN) :: pt 28 REAL(KIND=wp), INTENT(IN) :: pp 29 REAL(KIND=wp), INTENT(IN) :: ppr 30 31 !! * Local declarations 32 REAL(KIND=wp) :: zpol 33 REAL(KIND=wp), PARAMETER :: a1 = 1.067610e-05 34 REAL(KIND=wp), PARAMETER :: a2 = -1.434297e-06 35 REAL(KIND=wp), PARAMETER :: a3 = -7.566349e-09 36 REAL(KIND=wp), PARAMETER :: a4 = -8.535585e-06 37 REAL(KIND=wp), PARAMETER :: a5 = 3.074672e-08 38 REAL(KIND=wp), PARAMETER :: a6 = 1.918639e-08 39 REAL(KIND=wp), PARAMETER :: a7 = 1.788718e-10 42 40 43 41 zpol = a1 + a2 * ps + a3 * ( pp + ppr ) + a4 * pt & … … 67 65 68 66 !! * Arguments 69 REAL(KIND=wp) :: & 70 & pft, & ! in situ temperature in degrees celcius 71 & pfs, & ! salinity in psu 72 & pfp ! pressure in bars 67 REAL(KIND=wp) :: pft ! in situ temperature in degrees celcius 68 REAL(KIND=wp) :: pfs ! salinity in psu 69 REAL(KIND=wp) :: pfp ! pressure in bars 73 70 74 71 fspott = & … … 110 107 111 108 !! * Arguments 112 REAL(KIND=wp), INTENT(IN) :: & 113 & p_s, &! Salinity in PSU114 & p_t, &! Temperature in centigrades115 & p_p! Pressure in decibars.109 110 REAL(KIND=wp), INTENT(IN) :: p_s ! Salinity in PSU 111 REAL(KIND=wp), INTENT(IN) :: p_t ! Temperature in centigrades 112 REAL(KIND=wp), INTENT(IN) :: p_p ! Pressure in decibars. 116 113 117 114 !! * Local declarations … … 150 147 151 148 !! * Arguments 152 REAL(KIND=wp), INTENT(IN) :: & 153 & p_s, & 154 & p_t0, & 155 & p_p0, & 156 & p_pr 157 158 !! * Local declarations 159 REAL(KIND=wp) :: & 160 & z_p, & 161 & z_t, & 162 & z_h, & 163 & z_xk, & 164 & z_q 149 REAL(KIND=wp), INTENT(IN) :: p_s 150 REAL(KIND=wp), INTENT(IN) :: p_t0 151 REAL(KIND=wp), INTENT(IN) :: p_p0 152 REAL(KIND=wp), INTENT(IN) :: p_pr 153 154 !! * Local declarations 155 REAL(KIND=wp) :: z_p 156 REAL(KIND=wp) :: z_t 157 REAL(KIND=wp) :: z_h 158 REAL(KIND=wp) :: z_xk 159 REAL(KIND=wp) :: z_q 165 160 166 161 z_p = p_p0 … … 205 200 206 201 !! * Arguments 207 REAL(KIND=wp), INTENT(IN) :: & 208 & p_p, & ! Pressure in decibars 209 & p_lat ! Latitude in degrees 210 211 !! * Local declarations 212 REAL(KIND=wp) :: & 213 & z_x, & 214 & z_gr 202 REAL(KIND=wp), INTENT(IN) :: p_p ! Pressure in decibars 203 REAL(KIND=wp), INTENT(IN) :: p_lat ! Latitude in degrees 204 205 !! * Local declarations 206 REAL(KIND=wp) :: z_x 207 REAL(KIND=wp) :: z_gr 215 208 216 209 z_x = SIN( p_lat / 57.29578 ) … … 242 235 243 236 !! * Arguments 244 REAL(KIND=wp), INTENT(IN) :: & 245 & p_p, & ! Pressure in decibars 246 & p_lat ! Latitude in degrees 247 248 !! * Local declarations 249 REAL(KIND=wp) :: & 250 & z_x, & 251 & z_c1, & 252 & z_c2 237 REAL(KIND=wp), INTENT(IN) :: p_p ! Pressure in decibars 238 REAL(KIND=wp), INTENT(IN) :: p_lat ! Latitude in degrees 239 240 !! * Local declarations 241 REAL(KIND=wp) :: z_x 242 REAL(KIND=wp) :: z_c1 243 REAL(KIND=wp) :: z_c2 253 244 254 245 z_x = SIN( p_lat / 57.29578 ) … … 279 270 280 271 !! * Arguments 281 REAL(KIND=wp), INTENT(IN) :: & 282 & p_dep, & ! Depth in meters 283 & p_lat ! Latitude in degrees 284 285 !! * Local declarations 286 REAL(KIND=wp) :: & 287 & z_x, & 288 & z_c1, & 289 & z_c2, & 290 & z_d 272 REAL(KIND=wp), INTENT(IN) :: p_dep ! Depth in meters 273 REAL(KIND=wp), INTENT(IN) :: p_lat ! Latitude in degrees 274 275 !! * Local declarations 276 REAL(KIND=wp) :: z_x 277 REAL(KIND=wp) :: z_c1 278 REAL(KIND=wp) :: z_c2 279 REAL(KIND=wp) :: z_d 291 280 292 281 z_x = SIN( p_lat / 57.29578 ) -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_fbm.F90
r2001 r2074 49 49 50 50 TYPE obfbdata 51 LOGICAL :: & 52 & lalloc, & !: Allocation status for data 53 & lgrid !: Include grid search info 54 INTEGER :: & 55 & nvar, & !: Number of variables 56 & nobs, & !: Number of observations 57 & nlev, & !: Number of levels 58 & nadd, & !: Number of additional entries 59 & next, & !: Number of extra variables 60 & nqcf !: Number of words per qc flag 51 LOGICAL :: lalloc !: Allocation status for data 52 LOGICAL :: lgrid !: Include grid search info 53 INTEGER :: nvar !: Number of variables 54 INTEGER :: nobs !: Number of observations 55 INTEGER :: nlev !: Number of levels 56 INTEGER :: nadd !: Number of additional entries 57 INTEGER :: next !: Number of extra variables 58 INTEGER :: nqcf !: Number of words per qc flag 61 59 CHARACTER(LEN=ilenwmo), DIMENSION(:), POINTER :: & 62 60 & cdwmo !: Identifier … … 143 141 !!---------------------------------------------------------------------- 144 142 !! * Arguments 145 TYPE(obfbdata) :: & 146 & fbdata ! obsfbdata structure 143 TYPE(obfbdata) :: fbdata ! obsfbdata structure 147 144 148 145 fbdata%nvar = 0 … … 170 167 !!---------------------------------------------------------------------- 171 168 !! * Arguments 172 TYPE(obfbdata) :: & 173 & fbdata ! obsfbdata structure to be allocated 174 INTEGER, INTENT(IN) :: & 175 & kvar, & ! Number of variables 176 & kobs, & ! Number of observations 177 & klev, & ! Number of levels 178 & kadd, & ! Number of additional entries 179 & kext ! Number of extra variables 180 LOGICAL, INTENT(IN) :: & 181 & lgrid ! Include grid search information 182 INTEGER, OPTIONAL :: & 183 & kqcf ! Number of words for QC flags 169 TYPE(obfbdata) :: fbdata ! obsfbdata structure to be allocated 170 INTEGER, INTENT(IN) :: kvar ! Number of variables 171 INTEGER, INTENT(IN) :: kobs ! Number of observations 172 INTEGER, INTENT(IN) :: klev ! Number of levels 173 INTEGER, INTENT(IN) :: kadd ! Number of additional entries 174 INTEGER, INTENT(IN) :: kext ! Number of extra variables 175 LOGICAL, INTENT(IN) :: lgrid ! Include grid search information 176 INTEGER, OPTIONAL :: kqcf ! Number of words for QC flags 184 177 !! * Local variables 185 INTEGER :: & 186 & ji, & 187 & jv 178 INTEGER :: ji 179 INTEGER :: jv 188 180 189 181 ! Check allocation status and deallocate previous allocated structures … … 365 357 !!---------------------------------------------------------------------- 366 358 !! * Arguments 367 TYPE(obfbdata) :: & 368 & fbdata ! obsfbdata structure 359 TYPE(obfbdata) :: fbdata ! obsfbdata structure 369 360 370 361 ! Deallocate data … … 490 481 !!---------------------------------------------------------------------- 491 482 !! * Arguments 492 TYPE(obfbdata) :: & 493 & fbdata1, & ! Input obsfbdata structure 494 & fbdata2 ! Output obsfbdata structure 495 INTEGER, INTENT(IN), OPTIONAL :: & 496 & kadd, & ! Number of additional entries 497 & kext, & ! Number of extra variables 498 & kqcf ! Number of words per qc flags 499 LOGICAL, OPTIONAL :: & 500 & lgrid ! Grid info on output file 483 TYPE(obfbdata) :: fbdata1 ! Input obsfbdata structure 484 TYPE(obfbdata) :: fbdata2 ! Output obsfbdata structure 485 INTEGER, INTENT(IN), OPTIONAL :: kadd ! Number of additional entries 486 INTEGER, INTENT(IN), OPTIONAL :: kext ! Number of extra variables 487 INTEGER, INTENT(IN), OPTIONAL :: kqcf ! Number of words per qc flags 488 LOGICAL, OPTIONAL :: lgrid ! Grid info on output file 489 501 490 !! * Local variables 502 INTEGER :: & 503 & nadd, & 504 & next, & 505 & nqcf 506 LOGICAL :: & 507 & llgrid 508 INTEGER :: & 509 & jv, & 510 & je, & 511 & ji, & 512 & jk, & 513 & jq 491 INTEGER :: nadd 492 INTEGER :: next 493 INTEGER :: nqcf 494 LOGICAL :: llgrid 495 INTEGER :: jv 496 INTEGER :: je 497 INTEGER :: ji 498 INTEGER :: jk 499 INTEGER :: jq 514 500 515 501 ! Check allocation status of fbdata1 … … 621 607 fbdata2%ipqcf(jq,ji) = fbdata1%ipqcf(jq,ji) 622 608 fbdata2%itqcf(jq,ji) = fbdata1%itqcf(jq,ji) 623 END DO609 END DO 624 610 DO jk = 1, fbdata1%nlev 625 611 fbdata2%idqc(jk,ji) = fbdata1%idqc(jk,ji) … … 627 613 DO jq = 1, fbdata1%nqcf 628 614 fbdata2%idqcf(jq,jk,ji) = fbdata1%idqcf(jq,jk,ji) 629 END DO630 END DO631 END DO615 END DO 616 END DO 617 END DO 632 618 633 619 ! Copy the variable data … … 641 627 DO jq = 1, fbdata1%nqcf 642 628 fbdata2%ivqcf(jq,ji,jv) = fbdata1%ivqcf(jq,ji,jv) 643 END DO629 END DO 644 630 DO jk = 1, fbdata1%nlev 645 631 fbdata2%ivlqc(jk,ji,jv) = fbdata1%ivlqc(jk,ji,jv) … … 647 633 DO jq = 1, fbdata1%nqcf 648 634 fbdata2%ivlqcf(jq,jk,ji,jv) = fbdata1%ivlqcf(jq,jk,ji,jv) 649 END DO650 END DO651 END DO652 END DO635 END DO 636 END DO 637 END DO 638 END DO 653 639 654 640 ! Copy grid information … … 663 649 DO jk = 1, fbdata1%nlev 664 650 fbdata2%iobsk(jk,ji,jv) = fbdata1%iobsk(jk,ji,jv) 665 END DO666 END DO667 END DO651 END DO 652 END DO 653 END DO 668 654 ENDIF 669 655 … … 672 658 DO je = 1, MIN( fbdata1%nadd, fbdata2%nadd ) 673 659 fbdata2%caddname(je) = fbdata1%caddname(je) 674 END DO660 END DO 675 661 DO jv = 1, fbdata1%nvar 676 662 DO je = 1, MIN( fbdata1%nadd, fbdata2%nadd ) … … 680 666 DO jk = 1, fbdata1%nlev 681 667 fbdata2%padd(jk,ji,je,jv) = fbdata1%padd(jk,ji,je,jv) 682 END DO683 END DO684 END DO685 END DO668 END DO 669 END DO 670 END DO 671 END DO 686 672 687 673 ! Copy extra information … … 691 677 fbdata2%cextlong(je) = fbdata1%cextlong(je) 692 678 fbdata2%cextunit(je) = fbdata1%cextunit(je) 693 END DO679 END DO 694 680 DO je = 1, fbdata1%next 695 681 DO ji = 1, fbdata1%nobs 696 682 DO jk = 1, fbdata1%nlev 697 683 fbdata2%pext(jk,ji,je) = fbdata1%pext(jk,ji,je) 698 END DO699 END DO700 END DO684 END DO 685 END DO 686 END DO 701 687 702 688 END SUBROUTINE copy_obfbdata … … 716 702 !!---------------------------------------------------------------------- 717 703 !! * Arguments 718 TYPE(obfbdata) :: & 719 & fbdata1, & ! Input obsfbdata structure 720 & fbdata2 ! Output obsfbdata structure 721 LOGICAL, DIMENSION(fbdata1%nobs) :: & 722 & llvalid ! Grid info on output file 704 TYPE(obfbdata) :: fbdata1 ! Input obsfbdata structure 705 TYPE(obfbdata) :: fbdata2 ! Output obsfbdata structure 706 LOGICAL, DIMENSION(fbdata1%nobs) :: llvalid ! Grid info on output file 723 707 !! * Local variables 724 INTEGER :: & 725 & nobs 726 INTEGER :: & 727 & jv, & 728 & je, & 729 & ji, & 730 & jk, & 731 & jq, & 732 & ij 708 INTEGER :: nobs 709 INTEGER :: jv 710 INTEGER :: je 711 INTEGER :: ji 712 INTEGER :: jk 713 INTEGER :: jq 714 INTEGER :: ij 733 715 734 716 ! Check allocation status of fbdata1 … … 777 759 fbdata2%ipqcf(jq,ij) = fbdata1%ipqcf(jq,ji) 778 760 fbdata2%itqcf(jq,ij) = fbdata1%itqcf(jq,ji) 779 END DO761 END DO 780 762 DO jk = 1, fbdata1%nlev 781 763 fbdata2%idqc(jk,ij) = fbdata1%idqc(jk,ji) … … 783 765 DO jq = 1, fbdata1%nqcf 784 766 fbdata2%idqcf(jq,jk,ij) = fbdata1%idqcf(jq,jk,ji) 785 END DO786 END DO787 ENDIF 788 END DO767 END DO 768 END DO 769 ENDIF 770 END DO 789 771 790 772 ! Copy the variable data … … 801 783 DO jq = 1, fbdata1%nqcf 802 784 fbdata2%ivqcf(jq,ij,jv) = fbdata1%ivqcf(jq,ji,jv) 803 END DO785 END DO 804 786 DO jk = 1, fbdata1%nlev 805 787 fbdata2%ivlqc(jk,ij,jv) = fbdata1%ivlqc(jk,ji,jv) … … 807 789 DO jq = 1, fbdata1%nqcf 808 790 fbdata2%ivlqcf(jq,jk,ij,jv) = fbdata1%ivlqcf(jq,jk,ji,jv) 809 END DO810 END DO791 END DO 792 END DO 811 793 ENDIF 812 END DO813 END DO794 END DO 795 END DO 814 796 815 797 ! Copy grid information … … 827 809 DO jk = 1, fbdata1%nlev 828 810 fbdata2%iobsk(jk,ij,jv) = fbdata1%iobsk(jk,ji,jv) 829 END DO811 END DO 830 812 ENDIF 831 END DO832 END DO813 END DO 814 END DO 833 815 ENDIF 834 816 … … 837 819 DO je = 1, fbdata1%nadd 838 820 fbdata2%caddname(je) = fbdata1%caddname(je) 839 END DO821 END DO 840 822 DO jv = 1, fbdata1%nvar 841 823 DO je = 1, fbdata1%nadd … … 848 830 DO jk = 1, fbdata1%nlev 849 831 fbdata2%padd(jk,ij,je,jv) = fbdata1%padd(jk,ji,je,jv) 850 END DO832 END DO 851 833 ENDIF 852 END DO853 END DO854 END DO834 END DO 835 END DO 836 END DO 855 837 856 838 ! Copy extra information … … 860 842 fbdata2%cextlong(je) = fbdata1%cextlong(je) 861 843 fbdata2%cextunit(je) = fbdata1%cextunit(je) 862 END DO844 END DO 863 845 DO je = 1, fbdata1%next 864 846 ij = 0 … … 868 850 DO jk = 1, fbdata1%nlev 869 851 fbdata2%pext(jk,ij,je) = fbdata1%pext(jk,ji,je) 870 END DO852 END DO 871 853 ENDIF 872 END DO873 END DO854 END DO 855 END DO 874 856 875 857 END SUBROUTINE subsamp_obfbdata … … 892 874 !!---------------------------------------------------------------------- 893 875 !! * Arguments 894 INTEGER, INTENT(IN):: & 895 & nsets ! Number of input data sets 896 TYPE(obfbdata), DIMENSION(nsets) :: & 897 & fbdatain ! Input obsfbdata structure 898 TYPE(obfbdata) :: & 899 & fbdataout ! Output obsfbdata structure 876 INTEGER, INTENT(IN):: nsets ! Number of input data sets 877 TYPE(obfbdata), DIMENSION(nsets) :: fbdatain ! Input obsfbdata structure 878 TYPE(obfbdata) :: fbdataout ! Output obsfbdata structure 900 879 INTEGER, INTENT(IN), DIMENSION(fbdataout%nobs) :: & 901 880 & iset ! Set number for a given obs. … … 905 884 & iind ! Indices for copying. 906 885 !! * Local variables 907 INTEGER :: & 908 & js, &909 & jo, &910 & jv, &911 & je, &912 & ji, &913 & jk, &914 &jq886 887 INTEGER :: js 888 INTEGER :: jo 889 INTEGER :: jv 890 INTEGER :: je 891 INTEGER :: ji 892 INTEGER :: jk 893 INTEGER :: jq 915 894 916 895 ! Check allocation status of fbdatain … … 921 900 & __LINE__ ) 922 901 ENDIF 923 END DO902 END DO 924 903 925 904 ! Check allocation status of fbdataout … … 978 957 fbdataout%ipqcf(jq,jo) = fbdatain(js)%ipqcf(jq,ji) 979 958 fbdataout%itqcf(jq,jo) = fbdatain(js)%itqcf(jq,ji) 980 END DO959 END DO 981 960 DO jk = 1, fbdatain(js)%nlev 982 961 fbdataout%pdep(jk,jo) = fbdatain(js)%pdep(jk,ji) … … 984 963 DO jq = 1, fbdatain(js)%nqcf 985 964 fbdataout%idqcf(jq,jk,jo) = fbdatain(js)%idqcf(jq,jk,ji) 986 END DO987 END DO965 END DO 966 END DO 988 967 989 968 ! Merge the variable data … … 993 972 DO jq = 1, fbdatain(js)%nqcf 994 973 fbdataout%ivqcf(jq,jo,jv) = fbdatain(js)%ivqcf(jq,ji,jv) 995 END DO974 END DO 996 975 DO jk = 1, fbdatain(js)%nlev 997 976 fbdataout%ivlqc(jk,jo,jv) = fbdatain(js)%ivlqc(jk,ji,jv) … … 1000 979 fbdataout%ivlqcf(jq,jk,jo,jv) = & 1001 980 & fbdatain(js)%ivlqcf(jq,jk,ji,jv) 1002 END DO1003 END DO1004 END DO981 END DO 982 END DO 983 END DO 1005 984 1006 985 ! Merge grid information … … 1014 993 DO jk = 1, fbdatain(js)%nlev 1015 994 fbdataout%iobsk(jk,jo,jv) = fbdatain(js)%iobsk(jk,ji,jv) 1016 END DO1017 END DO995 END DO 996 END DO 1018 997 ENDIF 1019 998 … … 1024 1003 DO jk = 1, fbdatain(js)%nlev 1025 1004 fbdataout%padd(jk,jo,je,jv) = fbdatain(js)%padd(jk,ji,je,jv) 1026 END DO1027 END DO1028 END DO1005 END DO 1006 END DO 1007 END DO 1029 1008 1030 1009 ! Merge extra information … … 1033 1012 DO jk = 1, fbdatain(js)%nlev 1034 1013 fbdataout%pext(jk,jo,je) = fbdatain(js)%pext(jk,ji,je) 1035 END DO1036 END DO1037 1038 END DO1014 END DO 1015 END DO 1016 1017 END DO 1039 1018 1040 1019 END SUBROUTINE merge_obfbdata … … 1052 1031 !!---------------------------------------------------------------------- 1053 1032 !! * Arguments 1054 CHARACTER(len=*) :: & 1055 & cdfilename ! Output filename 1056 TYPE(obfbdata) :: & 1057 & fbdata ! obsfbdata structure 1033 CHARACTER(len=*) :: cdfilename ! Output filename 1034 TYPE(obfbdata) :: fbdata ! obsfbdata structure 1058 1035 !! * Local variables 1059 CHARACTER(LEN=14), PARAMETER :: & 1060 & cpname = 'write_obfbdata' 1061 INTEGER :: & ! Dimension ids 1062 & idfile, & 1063 & idodim, & 1064 & idldim, & 1065 & idvdim, & 1066 & idadim, & 1067 & idedim, & 1068 & idsndim, & 1069 & idsgdim, & 1070 & idswdim, & 1071 & idstdim, & 1072 & idjddim, & 1073 & idqcdim 1074 INTEGER :: & 1075 & idvard, & 1076 & idaddd, & 1077 & idextd, & 1078 & idcdwmo, & 1079 & idcdtyp, & 1080 & idplam, & 1081 & idpphi, & 1082 & idpdep, & 1083 & idptim, & 1084 & idptimr, & 1085 & idioqc, & 1086 & idioqcf, & 1087 & idipqc, & 1088 & idipqcf, & 1089 & iditqc, & 1090 & iditqcf, & 1091 & ididqc, & 1092 & ididqcf, & 1093 & idkindex 1036 CHARACTER(LEN=14), PARAMETER :: cpname = 'write_obfbdata' 1037 ! Dimension ids 1038 INTEGER :: idfile 1039 INTEGER :: idodim 1040 INTEGER :: idldim 1041 INTEGER :: idvdim 1042 INTEGER :: idadim 1043 INTEGER :: idedim 1044 INTEGER :: idsndim 1045 INTEGER :: idsgdim 1046 INTEGER :: idswdim 1047 INTEGER :: idstdim 1048 INTEGER :: idjddim 1049 INTEGER :: idqcdim 1050 INTEGER :: idvard 1051 INTEGER :: idaddd 1052 INTEGER :: idextd 1053 INTEGER :: idcdwmo 1054 INTEGER :: idcdtyp 1055 INTEGER :: idplam 1056 INTEGER :: idpphi 1057 INTEGER :: idpdep 1058 INTEGER :: idptim 1059 INTEGER :: idptimr 1060 INTEGER :: idioqc 1061 INTEGER :: idioqcf 1062 INTEGER :: idipqc 1063 INTEGER :: idipqcf 1064 INTEGER :: iditqc 1065 INTEGER :: iditqcf 1066 INTEGER :: ididqc 1067 INTEGER :: ididqcf 1068 INTEGER :: idkindex 1094 1069 INTEGER, DIMENSION(fbdata%nvar) :: & 1095 1070 & idpob, & … … 1102 1077 & idiobsk, & 1103 1078 & idcgrid 1104 INTEGER, DIMENSION(fbdata%nadd,fbdata%nvar) :: & 1105 & idpadd 1106 INTEGER, DIMENSION(fbdata%next) :: & 1107 & idpext 1108 INTEGER, DIMENSION(1) :: & 1109 & incdim1 1110 INTEGER, DIMENSION(2) :: & 1111 & incdim2 1112 INTEGER, DIMENSION(3) :: & 1113 & incdim3 1114 INTEGER, DIMENSION(4) :: & 1115 & incdim4 1116 INTEGER :: & 1117 & jv, & 1118 & je 1119 INTEGER :: & 1120 & ioldfill 1079 INTEGER, DIMENSION(fbdata%nadd,fbdata%nvar) :: idpadd 1080 INTEGER, DIMENSION(fbdata%next) :: idpext 1081 INTEGER, DIMENSION(1) :: incdim1 1082 INTEGER, DIMENSION(2) :: incdim2 1083 INTEGER, DIMENSION(3) :: incdim3 1084 INTEGER, DIMENSION(4) :: incdim4 1085 1086 INTEGER :: jv 1087 INTEGER :: je 1088 INTEGER :: ioldfill 1121 1089 CHARACTER(len=nf90_max_name) :: & 1122 1090 & cdtmp … … 1347 1315 & cdunits = fbdata%caddunit(je,jv), & 1348 1316 & rfillvalue = fbrmdi ) 1349 END DO1317 END DO 1350 1318 ENDIF 1351 1319 … … 1423 1391 ENDIF 1424 1392 1425 END DO1393 END DO 1426 1394 1427 1395 IF ( fbdata%next > 0 ) THEN … … 1437 1405 & cdunits = fbdata%cextunit(je), & 1438 1406 & rfillvalue = fbrmdi ) 1439 END DO1407 END DO 1440 1408 ENDIF 1441 1409 … … 1505 1473 & fbdata%padd(:,:,je,jv) ), & 1506 1474 & cpname, __LINE__ ) 1507 END DO1475 END DO 1508 1476 ENDIF 1509 1477 CALL chkerr( nf90_put_var( idfile, idivqc(jv), & … … 1533 1501 & cpname, __LINE__ ) 1534 1502 ENDIF 1535 END DO1503 END DO 1536 1504 1537 1505 IF ( fbdata%next > 0 ) THEN … … 1540 1508 & fbdata%pext(:,:,je) ), & 1541 1509 & cpname, __LINE__ ) 1542 END DO1510 END DO 1543 1511 ENDIF 1544 1512 … … 1566 1534 !!---------------------------------------------------------------------- 1567 1535 !! * Arguments 1568 INTEGER :: & 1569 & idfile, & ! File netcdf id. 1570 & idvar ! Variable netcdf id. 1571 CHARACTER(len=*) :: & 1572 & cdlongname ! Long name for variable 1573 CHARACTER(len=*), OPTIONAL :: & 1574 & cdunits ! Units for variable 1575 CHARACTER(len=*), OPTIONAL :: & 1576 & cfillvalue ! Fill value for character variables 1577 INTEGER, OPTIONAL :: & 1578 & ifillvalue ! Fill value for integer variables 1579 REAL(kind=fbsp), OPTIONAL :: & 1580 & rfillvalue ! Fill value for real variables 1581 CHARACTER(len=*), OPTIONAL :: & 1582 & conventions ! Conventions for variable 1536 INTEGER :: idfile ! File netcdf id. 1537 INTEGER :: idvar ! Variable netcdf id. 1538 CHARACTER(len=*) :: cdlongname ! Long name for variable 1539 CHARACTER(len=*), OPTIONAL :: cdunits ! Units for variable 1540 CHARACTER(len=*), OPTIONAL :: cfillvalue ! Fill value for character variables 1541 INTEGER, OPTIONAL :: ifillvalue ! Fill value for integer variables 1542 REAL(kind=fbsp), OPTIONAL :: rfillvalue ! Fill value for real variables 1543 CHARACTER(len=*), OPTIONAL :: conventions ! Conventions for variable 1583 1544 !! * Local variables 1584 1545 CHARACTER(LEN=18), PARAMETER :: & … … 1643 1604 !!---------------------------------------------------------------------- 1644 1605 !! * Arguments 1645 CHARACTER(len=*) :: & 1646 & cdfilename ! Input filename 1647 TYPE(obfbdata) :: & 1648 & fbdata ! obsfbdata structure 1649 LOGICAL, OPTIONAL :: & 1650 & ldgrid ! Allow forcing of grid info 1606 CHARACTER(len=*) :: cdfilename ! Input filename 1607 TYPE(obfbdata) :: fbdata ! obsfbdata structure 1608 LOGICAL, OPTIONAL :: ldgrid ! Allow forcing of grid info 1651 1609 !! * Local variables 1652 1610 CHARACTER(LEN=14), PARAMETER :: cpname = 'read_obfbdata' 1653 INTEGER :: & 1654 & idfile, & 1655 & idodim, & 1656 & idldim, & 1657 & idvdim, & 1658 & idadim, & 1659 & idedim, & 1660 & idgdim 1661 INTEGER :: & 1662 & idvard, & 1663 & idaddd, & 1664 & idextd, & 1665 & idcdwmo, & 1666 & idcdtyp, & 1667 & idplam, & 1668 & idpphi, & 1669 & idpdep, & 1670 & idptim, & 1671 & idptimr, & 1672 & idioqc, & 1673 & idioqcf, & 1674 & idipqc, & 1675 & idipqcf, & 1676 & ididqc, & 1677 & ididqcf, & 1678 & iditqc, & 1679 & iditqcf, & 1680 & idkindex 1611 INTEGER :: idfile 1612 INTEGER :: idodim 1613 INTEGER :: idldim 1614 INTEGER :: idvdim 1615 INTEGER :: idadim 1616 INTEGER :: idedim 1617 INTEGER :: idgdim 1618 INTEGER :: idvard 1619 INTEGER :: idaddd 1620 INTEGER :: idextd 1621 INTEGER :: idcdwmo 1622 INTEGER :: idcdtyp 1623 INTEGER :: idplam 1624 INTEGER :: idpphi 1625 INTEGER :: idpdep 1626 INTEGER :: idptim 1627 INTEGER :: idptimr 1628 INTEGER :: idioqc 1629 INTEGER :: idioqcf 1630 INTEGER :: idipqc 1631 INTEGER :: idipqcf 1632 INTEGER :: ididqc 1633 INTEGER :: ididqcf 1634 INTEGER :: iditqc 1635 INTEGER :: iditqcf 1636 INTEGER :: idkindex 1681 1637 INTEGER, DIMENSION(:), ALLOCATABLE :: & 1682 1638 & idpob, & … … 1692 1648 INTEGER, DIMENSION(:,:), ALLOCATABLE :: & 1693 1649 & idpadd 1694 INTEGER :: & 1695 & jv, & 1696 & je 1697 INTEGER :: & 1698 & nvar, & 1699 & nobs, & 1700 & nlev, & 1701 & nadd, & 1702 & next 1703 LOGICAL :: & 1704 & lgrid 1705 CHARACTER(len=NF90_MAX_NAME) :: & 1706 & cdtmp 1650 INTEGER :: jv 1651 INTEGER :: je 1652 INTEGER :: nvar 1653 INTEGER :: nobs 1654 INTEGER :: nlev 1655 INTEGER :: nadd 1656 INTEGER :: next 1657 LOGICAL :: lgrid 1658 CHARACTER(len=NF90_MAX_NAME) :: cdtmp 1707 1659 1708 1660 ! Check allocation status and deallocate previous allocated structures … … 1895 1847 & fbdata%caddlong(je,jv), & 1896 1848 & fbdata%caddunit(je,jv) ) 1897 END DO1849 END DO 1898 1850 ENDIF 1899 1851 … … 1949 1901 ENDIF 1950 1902 1951 END DO1903 END DO 1952 1904 1953 1905 IF ( fbdata%next > 0 ) THEN … … 1962 1914 & fbdata%cextlong(je), & 1963 1915 & fbdata%cextunit(je) ) 1964 END DO1916 END DO 1965 1917 ENDIF 1966 1918 1967 1919 ELSE ! if no observations only get attributes 1968 1920 1969 DO jv = 1, fbdata%nvar 1970 1921 DO jv = 1, fbdata%nvar 1922 1971 1923 WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_OBS' 1972 1924 CALL chkerr( nf90_inq_varid( idfile, cdtmp, idpob(jv) ), & … … 1985 1937 & fbdata%caddlong(je,jv), & 1986 1938 & fbdata%caddunit(je,jv) ) 1987 ENDDO 1988 1939 END DO 1989 1940 ENDIF 1990 1941 1991 END DO1942 END DO 1992 1943 1993 1944 IF ( fbdata%next > 0 ) THEN … … 1999 1950 & fbdata%cextlong(je), & 2000 1951 & fbdata%cextunit(je) ) 2001 END DO1952 END DO 2002 1953 ENDIF 2003 1954 … … 2022 1973 !!---------------------------------------------------------------------- 2023 1974 !! * Arguments 2024 INTEGER :: & 2025 & idfile, & ! File netcdf id. 2026 & idvar ! Variable netcdf id. 2027 CHARACTER(len=*) :: & 2028 & cdlongname ! Long name for variable 2029 CHARACTER(len=*) :: & 2030 & cdunits ! Units for variable 1975 INTEGER :: idfile ! File netcdf id. 1976 INTEGER :: idvar ! Variable netcdf id. 1977 CHARACTER(len=*) :: cdlongname ! Long name for variable 1978 CHARACTER(len=*) :: cdunits ! Units for variable 2031 1979 !! * Local variables 2032 CHARACTER(LEN=18), PARAMETER :: & 2033 & cpname = 'getvaratt_obfbdata' 1980 CHARACTER(LEN=18), PARAMETER :: cpname = 'getvaratt_obfbdata' 2034 1981 2035 1982 CALL chkerr( nf90_get_att( idfile, idvar, 'long_name', & -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_grid.F90
r2001 r2074 78 78 79 79 ! Switches 80 LOGICAL, PUBLIC :: & 81 & ln_grid_search_lookup ! Use lookup table to speed up grid search 82 LOGICAL, PUBLIC :: & 83 & ln_grid_global ! Use global distribution of observations 80 LOGICAL, PUBLIC :: ln_grid_search_lookup ! Use lookup table to speed up grid search 81 LOGICAL, PUBLIC :: ln_grid_global ! Use global distribution of observations 84 82 CHARACTER(LEN=44), PUBLIC :: & 85 83 & grid_search_file ! file name head for grid search lookup … … 179 177 180 178 !! * Arguments 181 INTEGER :: & 182 & kobs ! Size of the observation arrays 179 INTEGER :: kobs ! Size of the observation arrays 183 180 REAL(KIND=wp), DIMENSION(kobs), INTENT(IN) :: & 184 181 & plam, & ! Longitude of obsrvations … … 192 189 REAL(KIND=wp), DIMENSION(:), ALLOCATABLE :: & 193 190 & zplam 194 REAL(wp) :: & 195 & zlammax, & 196 & zlam 197 INTEGER :: & 198 & ji, & 199 & jj, & 200 & jk, & 201 & jo, & 202 & isx, & 203 & isy, & 204 & jimin, & 205 & jimax, & 206 & jjmin, & 207 & jjmax, & 208 & jojimin, & 209 & jojimax, & 210 & jojjmin, & 211 & jojjmax, & 212 & ipx1, & 213 & ipy1, & 214 & ip, & 215 & jp, & 216 & ipx, & 217 & ipy, & 218 & ipmx, & 219 & jlon, & 220 & jlat, & 221 & joffset, & 222 & jostride 191 REAL(wp) :: zlammax 192 REAL(wp) :: zlam 193 INTEGER :: ji 194 INTEGER :: jj 195 INTEGER :: jk 196 INTEGER :: jo 197 INTEGER :: isx 198 INTEGER :: isy 199 INTEGER :: jimin 200 INTEGER :: jimax 201 INTEGER :: jjmin 202 INTEGER :: jjmax 203 INTEGER :: jojimin 204 INTEGER :: jojimax 205 INTEGER :: jojjmin 206 INTEGER :: jojjmax 207 INTEGER :: ipx1 208 INTEGER :: ipy1 209 INTEGER :: ip 210 INTEGER :: jp 211 INTEGER :: ipx 212 INTEGER :: ipy 213 INTEGER :: ipmx 214 INTEGER :: jlon 215 INTEGER :: jlat 216 INTEGER :: joffset 217 INTEGER :: jostride 223 218 REAL(KIND=wp), DIMENSION(:,:), ALLOCATABLE :: & 224 219 & zlamg, & … … 234 229 & zlamtm, & 235 230 & zphitm 236 LOGICAL :: & 237 & llfourflag 238 INTEGER :: & 239 & ifourflagcountt, & 240 & ifourflagcountf 241 INTEGER, DIMENSION(5) :: & 242 & ifourflagcountr 231 LOGICAL :: llfourflag 232 INTEGER :: ifourflagcountt 233 INTEGER :: ifourflagcountf 234 INTEGER, DIMENSION(5) :: ifourflagcountr 243 235 244 236 !----------------------------------------------------------------------- … … 307 299 DO jo = 1, kobs 308 300 zplam(jo) = plam(jo) 309 END DO301 END DO 310 302 !----------------------------------------------------------------------- 311 303 ! Set default values for output … … 520 512 kobsj(jo) = jj + 1 521 513 EXIT gridloop 522 END 514 ENDIF 523 515 ENDIF 524 516 ENDIF 525 END DO526 END DO gridloop517 END DO 518 END DO gridloop 527 519 528 520 !--------------------------------------------------------------- … … 655 647 & cpname = 'obs_grid_setup' 656 648 CHARACTER(LEN=40) :: cfname 657 INTEGER :: & 658 & ji, & 659 & jj, & 660 & jk, & 661 & jo 662 INTEGER :: & 663 & idfile, idny, idnx, idxpos, idypos, idlat, idlon, fileexist 649 INTEGER :: ji 650 INTEGER :: jj 651 INTEGER :: jk 652 INTEGER :: jo 653 INTEGER :: idfile, idny, idnx, idxpos, idypos 654 INTEGER :: idlat, idlon, fileexist 664 655 INTEGER, DIMENSION(2) :: incdim 665 656 CHARACTER(LEN=20) :: datestr=" ",timestr=" " … … 669 660 REAL(wp) :: meanxdiff2, meanydiff2 670 661 INTEGER :: numx1, numx2, numy1, numy2, df 671 INTEGER :: & 672 & jimin, jimax, jjmin, jjmax 662 INTEGER :: jimin, jimax, jjmin, jjmax 673 663 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: & 674 664 & lonsi, & … … 782 772 lons(ji,jj) = lonmin + (ji-1) * dlon 783 773 lats(ji,jj) = latmin + (jj-1) * dlat 784 END DO785 END DO774 END DO 775 END DO 786 776 787 777 ! if we are not reading the file we need to create it … … 819 809 lonsi(ji,jj) = lonmin + (ji-1) * dlon 820 810 latsi(ji,jj) = latmin + (jj-1) * dlat 821 END DO822 END DO811 END DO 812 END DO 823 813 824 814 CALL obs_grid_search_bruteforce( jpi, jpj, jpiglo, jpjglo, & … … 842 832 EXIT minlon_xpos 843 833 ENDIF 844 END DO minlon_xpos834 END DO minlon_xpos 845 835 846 836 maxlon_xpos: DO ji= nlons, 1, -1 … … 849 839 EXIT maxlon_xpos 850 840 ENDIF 851 END DO maxlon_xpos841 END DO maxlon_xpos 852 842 853 843 minlat_xpos: DO jj= 1, nlats … … 856 846 EXIT minlat_xpos 857 847 ENDIF 858 END DO minlat_xpos848 END DO minlat_xpos 859 849 860 850 maxlat_xpos: DO jj= nlats, 1, -1 … … 863 853 EXIT maxlat_xpos 864 854 ENDIF 865 END DO maxlat_xpos855 END DO maxlat_xpos 866 856 867 857 lonmin = lonsi(jimin,jjmin) … … 937 927 ENDIF 938 928 ENDIF 939 END DO940 END DO929 END DO 930 END DO 941 931 942 932 IF (lwp) THEN … … 1035 1025 histy1(ji+1) = histy1(ji+1) + histy1(ji) 1036 1026 histy2(ji+1) = histy2(ji+1) + histy2(ji) 1037 END DO1027 END DO 1038 1028 1039 1029 fhistx1(:) = histx1(:) * 1.0 / numx1 … … 1154 1144 ! obs_grid_search_lookup 1155 1145 1156 END 1146 ENDIF 1157 1147 1158 1148 ENDIF -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_grid_search_bruteforce.h90
r2001 r2074 24 24 25 25 !! * Arguments 26 INTEGER, INTENT(IN) :: & 27 & kpi, & ! Number of local longitudes 28 & kpj, & ! Number of local latitudes 29 & kpiglo, & ! Number of global longitudes 30 & kpjglo, & ! Number of global latitudes 31 & kldi, & ! Start of inner domain in i 32 & klei, & ! End of inner domain in i 33 & kldj, & ! Start of inner domain in j 34 & klej, & ! End of inner domain in j 35 & kmyproc, & ! Processor number for MPP 36 & ktotproc ! Total number of processors 26 INTEGER, INTENT(IN) :: kpi ! Number of local longitudes 27 INTEGER, INTENT(IN) :: kpj ! Number of local latitudes 28 INTEGER, INTENT(IN) :: kpiglo ! Number of global longitudes 29 INTEGER, INTENT(IN) :: kpjglo ! Number of global latitudes 30 INTEGER, INTENT(IN) :: kldi ! Start of inner domain in i 31 INTEGER, INTENT(IN) :: klei ! End of inner domain in i 32 INTEGER, INTENT(IN) :: kldj ! Start of inner domain in j 33 INTEGER, INTENT(IN) :: klej ! End of inner domain in j 34 INTEGER, INTENT(IN) :: kmyproc ! Processor number for MPP 35 INTEGER, INTENT(IN) :: ktotproc ! Total number of processors 37 36 REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(IN) :: & 38 37 & pglam, & ! Grid point longitude 39 38 & pgphi, & ! Grid point latitude 40 39 & pmask ! Grid point mask 41 INTEGER,INTENT(IN) :: & 42 & kobs ! Size of the observation arrays 40 INTEGER,INTENT(IN) :: kobs ! Size of the observation arrays 43 41 REAL(KIND=wp), DIMENSION(kobs), INTENT(IN) :: & 44 42 & plam, & ! Longitude of obsrvations … … 52 50 REAL(wp), DIMENSION(:), ALLOCATABLE :: & 53 51 & zplam, zpphi 54 REAL(wp) :: & 55 & zlammax, & 56 & zlam 57 INTEGER :: & 58 & ji, & 59 & jj, & 60 & jk, & 61 & jo, & 62 & jlon, & 63 & jlat, & 64 & joffset, & 65 & jostride 52 REAL(wp) :: zlammax 53 REAL(wp) :: zlam 54 INTEGER :: ji 55 INTEGER :: jj 56 INTEGER :: jk 57 INTEGER :: jo 58 INTEGER :: jlon 59 INTEGER :: jlat 60 INTEGER :: joffset 61 INTEGER :: jostride 66 62 REAL(KIND=wp), DIMENSION(:,:), ALLOCATABLE :: & 67 63 & zlamg, & … … 143 139 zplam(jo) = plam(jo) 144 140 zpphi(jo) = pphi(jo) 145 END DO141 END DO 146 142 !----------------------------------------------------------------------- 147 143 ! Set default values for output … … 233 229 kobsj(jo) = jj + 1 234 230 EXIT gridloop 235 END 231 ENDIF 236 232 ENDIF 237 233 ENDIF 238 END DO239 END DO gridloop234 END DO 235 END DO gridloop 240 236 241 237 !--------------------------------------------------------------------- -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_inter_h2d.h90
r2001 r2074 1181 1181 pmatou(ji,jj) = 0.0_wp 1182 1182 zmat(ji,jj) = pmatin(ji,jj) 1183 END DO1183 END DO 1184 1184 pmatou(jj,jj) = 1.0_wp 1185 END DO1185 END DO 1186 1186 CALL lu_decomp( zmat, kdim, kdim, indx, zd ) 1187 1187 DO jj = 1, kdim -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_inter_sup.F90
r2001 r2074 47 47 !!---------------------------------------------------------------------- 48 48 !! * Arguments 49 INTEGER, INTENT(IN) :: & 50 & kptsi, & ! Number of i horizontal points per stencil 51 & kptsj, & ! Number of j horizontal points per stencil 52 & kobs, & ! Local number of observations 53 & kpk ! Number of levels 49 INTEGER, INTENT(IN) :: kptsi ! Number of i horizontal points per stencil 50 INTEGER, INTENT(IN) :: kptsj ! Number of j horizontal points per stencil 51 INTEGER, INTENT(IN) :: kobs ! Local number of observations 52 INTEGER, INTENT(IN) :: kpk ! Number of levels 54 53 INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 55 54 & kgrdi, & ! i,j indicies for each stencil … … 101 100 !!---------------------------------------------------------------------- 102 101 !! * Arguments 103 INTEGER, INTENT(IN) :: & 104 & kptsi, & ! Number of i horizontal points per stencil 105 & kptsj, & ! Number of j horizontal points per stencil 106 & kobs ! Local number of observations 102 INTEGER, INTENT(IN) :: kptsi ! Number of i horizontal points per stencil 103 INTEGER, INTENT(IN) :: kptsj ! Number of j horizontal points per stencil 104 INTEGER, INTENT(IN) :: kobs ! Local number of observations 107 105 INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 108 106 & kgrdi, & ! i,j indicies for each stencil … … 160 158 !!---------------------------------------------------------------------- 161 159 !! * Arguments 162 INTEGER, INTENT(IN) :: & 163 & kptsi, & ! Number of i horizontal points per stencil 164 & kptsj, & ! Number of j horizontal points per stencil 165 & kobs, & ! Local number of observations 166 & kpk ! Number of levels 160 INTEGER, INTENT(IN) :: kptsi ! Number of i horizontal points per stencil 161 INTEGER, INTENT(IN) :: kptsj ! Number of j horizontal points per stencil 162 INTEGER, INTENT(IN) :: kobs ! Local number of observations 163 INTEGER, INTENT(IN) :: kpk ! Number of levels 167 164 INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 168 165 & kgrdi, & ! i,j indicies for each stencil … … 184 181 & iorder, & 185 182 & iproc 186 INTEGER :: & 187 & nplocal(jpnij), & 188 & npglobal(jpnij) 189 INTEGER :: & 190 & ji, & 191 & jj, & 192 & jk, & 193 & jp, & 194 & jobs, & 195 & it, & 196 & itot, & 197 & ii, & 198 & ij 183 INTEGER :: nplocal(jpnij) 184 INTEGER :: npglobal(jpnij) 185 INTEGER :: ji 186 INTEGER :: jj 187 INTEGER :: jk 188 INTEGER :: jp 189 INTEGER :: jobs 190 INTEGER :: it 191 INTEGER :: itot 192 INTEGER :: ii 193 INTEGER :: ij 199 194 200 195 ! Check valid points … … 332 327 !!---------------------------------------------------------------------- 333 328 !! * Arguments 334 INTEGER, INTENT(IN) :: & 335 & kptsi, & ! Number of i horizontal points per stencil 336 & kptsj, & ! Number of j horizontal points per stencil 337 & kobs, & ! Local number of observations 338 & kpk ! Number of levels 329 INTEGER, INTENT(IN) :: kptsi ! Number of i horizontal points per stencil 330 INTEGER, INTENT(IN) :: kptsj ! Number of j horizontal points per stencil 331 INTEGER, INTENT(IN) :: kobs ! Local number of observations 332 INTEGER, INTENT(IN) :: kpk ! Number of levels 339 333 INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 340 334 & kgrdi, & ! i,j indicies for each stencil … … 345 339 & pgval ! Stencil at each point 346 340 !! * Local declarations 347 INTEGER :: & 348 & ji, & 349 & jj, & 350 & jk, & 351 & jobs 341 INTEGER :: ji 342 INTEGER :: jj 343 INTEGER :: jk 344 INTEGER :: jobs 352 345 353 346 ! Check valid points -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_inter_z1d.h90
r2001 r2074 23 23 24 24 !! * Arguments 25 INTEGER, INTENT(IN) :: & 26 & kpk, & ! Number of vertical levels 27 & k1dint, & ! 0 = linear; 1 = cubic spline interpolation 28 & kdep ! Number of levels in profile 25 INTEGER, INTENT(IN) :: kpk ! Number of vertical levels 26 INTEGER, INTENT(IN) :: k1dint ! 0 = linear; 1 = cubic spline interpolation 27 INTEGER, INTENT(IN) :: kdep ! Number of levels in profile 29 28 INTEGER, INTENT(IN), DIMENSION(kdep) :: & 30 29 & kkco ! Array indicies for interpolation … … 40 39 41 40 !! * Local declarations 42 REAL(KIND=wp) :: & 43 & z1dm, & ! Distance above and below obs to model grid points 44 & z1dp, & 45 & zsum, & ! Dummy variables for computation 46 & zsum2 47 INTEGER :: & 48 jdep ! Observation depths loop variable 41 REAL(KIND=wp) :: z1dm ! Distance above and below obs to model grid points 42 REAL(KIND=wp) :: z1dp 43 REAL(KIND=wp) :: zsum ! Dummy variables for computation 44 REAL(KIND=wp) :: zsum2 45 INTEGER :: jdep ! Observation depths loop variable 49 46 50 47 !------------------------------------------------------------------------ … … 85 82 86 83 ENDIF 87 END DO84 END DO 88 85 89 86 END SUBROUTINE obs_int_z1d … … 114 111 115 112 !! * Arguments 116 INTEGER, INTENT(IN) :: & 117 & kpk ! Number of vertical levels 113 INTEGER, INTENT(IN) :: kpk ! Number of vertical levels 118 114 REAL(KIND=wp), INTENT(IN), DIMENSION(kpk) :: & 119 115 & pobsk, & ! Model profile at a given (lon,lat) … … 124 120 125 121 !! * Local declarations 126 INTEGER :: & 127 & jk 128 REAL(KIND=wp) :: & 129 & za, & 130 & zb, & 131 & zc, & 132 & zpa, & 133 & zkm, & 134 & zkp, & 135 & zk 122 INTEGER :: jk 123 REAL(KIND=wp) :: za 124 REAL(KIND=wp) :: zb 125 REAL(KIND=wp) :: zc 126 REAL(KIND=wp) :: zpa 127 REAL(KIND=wp) :: zkm 128 REAL(KIND=wp) :: zkp 129 REAL(KIND=wp) :: zk 136 130 REAL(KIND=wp), DIMENSION(kpk-1) :: & 137 131 & zs, & -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_level_search.h90
r2001 r2074 18 18 19 19 !! * Arguments 20 INTEGER, INTENT(IN) :: & 21 & kgrd ! Number of gridpoints 20 INTEGER, INTENT(IN) :: kgrd ! Number of gridpoints 22 21 REAL(KIND=wp), DIMENSION(kgrd), INTENT(INOUT) :: & 23 22 & pgrddep ! Depths of gridpoints … … 30 29 31 30 !! * Local declarations 32 INTEGER :: & 33 & ji, & 34 & jk 31 INTEGER :: ji 32 INTEGER :: jk 35 33 36 34 !------------------------------------------------------------------------ -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_mpp.F90
r2001 r2074 69 69 70 70 !! * Arguments 71 INTEGER, INTENT(IN) :: & 72 & kno, & ! Number of elements in array 73 & kroot ! Processor to send data 71 INTEGER, INTENT(IN) :: kno ! Number of elements in array 72 INTEGER, INTENT(IN) :: kroot ! Processor to send data 74 73 INTEGER, DIMENSION(kno), INTENT(INOUT) :: & 75 74 & kvals ! Array to send on kroot, receive for non-kroot … … 77 76 #if defined key_mpp_mpi 78 77 !! * Local declarations 79 INTEGER :: & 80 & ierr 78 INTEGER :: ierr 81 79 # include <mpif.h> 82 80 … … 112 110 113 111 !! * Arguments 114 INTEGER, INTENT(IN) :: & 115 & kno ! Number of elements in array 112 INTEGER, INTENT(IN) ::kno ! Number of elements in array 116 113 INTEGER, DIMENSION(kno), INTENT(INOUT) :: & 117 114 & kvals ! Array to send on kroot, receive for non-kroot … … 119 116 #if defined key_mpp_mpi 120 117 !! * Local declarations 121 INTEGER :: & 122 & ierr 118 INTEGER :: ierr 123 119 INTEGER, DIMENSION(kno) :: & 124 120 & ivals … … 159 155 160 156 !! * Arguments 161 INTEGER, INTENT(IN) :: & 162 & kno 157 INTEGER, INTENT(IN) :: kno 163 158 INTEGER, DIMENSION(kno), INTENT(IN) :: & 164 159 & kobsi, & … … 169 164 #if defined key_mpp_mpi 170 165 !! * Local declarations 171 INTEGER :: & 172 & ji, & 173 & jj 174 INTEGER :: & 175 & size, & 176 & ierr, & 177 & iobsip, & 178 & iobsjp, & 179 & num_sus_obs 166 INTEGER :: ji 167 INTEGER :: jj 168 INTEGER :: size 169 INTEGER :: ierr 170 INTEGER :: iobsip 171 INTEGER :: iobsjp 172 INTEGER :: num_sus_obs 180 173 INTEGER, DIMENSION(kno) :: & 181 174 & iobsig, & … … 283 276 284 277 !! * Arguments 285 INTEGER, INTENT(IN) :: & 286 & kno 278 INTEGER, INTENT(IN) :: kno 287 279 INTEGER, DIMENSION(kno), INTENT(IN) :: & 288 280 & kvalsin … … 292 284 #if defined key_mpp_mpi 293 285 !! * Local declarations 294 INTEGER :: & 295 & ierr 286 INTEGER :: ierr 296 287 # include <mpif.h> 297 288 … … 331 322 332 323 !! * Arguments 333 INTEGER, INTENT(IN) :: & 334 & kvalin 335 INTEGER, INTENT(OUT) :: & 336 & kvalout 337 338 #if defined key_mpp_mpi 339 !! * Local declarations 340 INTEGER :: & 341 & ierr 324 INTEGER, INTENT(IN) :: kvalin 325 INTEGER, INTENT(OUT) :: kvalout 326 327 #if defined key_mpp_mpi 328 !! * Local declarations 329 INTEGER :: ierr 342 330 # include <mpif.h> 343 331 … … 380 368 & pval 381 369 !! * Local declarations 382 INTEGER :: & 383 & ierr 370 INTEGER :: ierr 384 371 #if defined key_mpp_mpi 385 372 #include <mpif.h> … … 427 414 428 415 !! * Arguments 429 INTEGER, INTENT(IN) :: & 430 & kno 416 INTEGER, INTENT(IN) :: kno 431 417 INTEGER, DIMENSION(kno*jpnij), INTENT(IN) :: & 432 418 & kvalsin … … 434 420 & kvalsout 435 421 !! * Local declarations 436 INTEGER :: & 437 & ierr 422 INTEGER :: ierr 438 423 #if defined key_mpp_mpi 439 424 #include <mpif.h> … … 474 459 475 460 !! * Arguments 476 INTEGER, INTENT(IN) :: & 477 & knoin, & 478 & knoout 461 INTEGER, INTENT(IN) :: knoin 462 INTEGER, INTENT(IN) :: knoout 479 463 INTEGER, DIMENSION(jpnij) :: & 480 464 & kinv, & … … 485 469 & kvalsout 486 470 !! * Local declarations 487 INTEGER :: & 488 & ierr, & 489 & jproc 471 INTEGER :: ierr 472 INTEGER :: jproc 490 473 #if defined key_mpp_mpi 491 474 #include <mpif.h> … … 501 484 isdsp(jproc) = isdsp(jproc-1) + kinv(jproc-1) 502 485 irdsp(jproc) = irdsp(jproc-1) + koutv(jproc-1) 503 END DO486 END DO 504 487 !----------------------------------------------------------------------- 505 488 ! Call the MPI library to do the all to all operation of the data … … 538 521 539 522 !! * Arguments 540 INTEGER, INTENT(IN) :: & 541 & knoin, & 542 & knoout 523 INTEGER, INTENT(IN) :: knoin 524 INTEGER, INTENT(IN) :: knoout 543 525 INTEGER, DIMENSION(jpnij) :: & 544 526 & kinv, & … … 549 531 & pvalsout 550 532 !! * Local declarations 551 INTEGER :: & 552 & ierr, & 553 & jproc 533 INTEGER :: ierr 534 INTEGER :: jproc 554 535 #if defined key_mpp_mpi 555 536 #include <mpif.h> … … 565 546 isdsp(jproc) = isdsp(jproc-1) + kinv(jproc-1) 566 547 irdsp(jproc) = irdsp(jproc-1) + koutv(jproc-1) 567 END DO548 END DO 568 549 !----------------------------------------------------------------------- 569 550 ! Call the MPI library to do the all to all operation of the data -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_oper.F90
r2001 r2074 115 115 116 116 !! * Arguments 117 TYPE(obs_prof), INTENT(INOUT) :: & 118 & prodatqc ! Subset of profile data not failing screening 119 INTEGER, INTENT(IN) :: & 120 & kt, & ! Time step 121 & kpi, & ! Model grid parameters 122 & kpj, & 123 & kpk, & 124 & kit000, & ! Number of the first time step 125 ! (kit000-1 = restart time) 126 & k1dint, & ! Vertical interpolation type (see header) 127 & k2dint, & ! Horizontal interpolation type (see header) 128 & kdaystp ! Number of time steps per day 117 TYPE(obs_prof), INTENT(INOUT) :: prodatqc ! Subset of profile data not failing screening 118 INTEGER, INTENT(IN) :: kt ! Time step 119 INTEGER, INTENT(IN) :: kpi ! Model grid parameters 120 INTEGER, INTENT(IN) :: kpj 121 INTEGER, INTENT(IN) :: kpk 122 INTEGER, INTENT(IN) :: kit000 ! Number of the first time step 123 ! (kit000-1 = restart time) 124 INTEGER, INTENT(IN) :: k1dint ! Vertical interpolation type (see header) 125 INTEGER, INTENT(IN) :: k2dint ! Horizontal interpolation type (see header) 126 INTEGER, INTENT(IN) :: kdaystp ! Number of time steps per day 129 127 REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: & 130 128 & ptn, & ! Model temperature field … … 136 134 & kdailyavtypes! Types for daily averages 137 135 !! * Local declarations 138 INTEGER :: & 139 & ji, & 140 & jj, & 141 & jk, & 142 & jobs, & 143 & inrc, & 144 & ipro, & 145 & idayend,& 146 & ista, & 147 & iend, & 148 & iobs 136 INTEGER :: ji 137 INTEGER :: jj 138 INTEGER :: jk 139 INTEGER :: jobs 140 INTEGER :: inrc 141 INTEGER :: ipro 142 INTEGER :: idayend 143 INTEGER :: ista 144 INTEGER :: iend 145 INTEGER :: iobs 149 146 INTEGER, DIMENSION(imaxavtypes) :: & 150 147 & idailyavtypes 151 REAL(KIND=wp) :: & 152 & zlam, & 153 & zphi, & 154 & zdaystp 148 REAL(KIND=wp) :: zlam 149 REAL(KIND=wp) :: zphi 150 REAL(KIND=wp) :: zdaystp 155 151 REAL(KIND=wp), DIMENSION(kpk) :: & 156 152 & zobsmask, & … … 421 417 ENDIF 422 418 423 END DO419 END DO 424 420 425 421 ! Deallocate the data for interpolation … … 482 478 483 479 !! * Arguments 484 TYPE(obs_surf), INTENT(INOUT) :: & 485 & sladatqc ! Subset of surface data not failing screening 486 INTEGER, INTENT(IN) :: & 487 & kt, & ! Time step 488 & kpi, & ! Model grid parameters 489 & kpj, & 490 & kit000, & ! Number of the first time step 491 ! (kit000-1 = restart time) 492 & k2dint ! Horizontal interpolation type (see header) 480 TYPE(obs_surf), INTENT(INOUT) :: sladatqc ! Subset of surface data not failing screening 481 INTEGER, INTENT(IN) :: kt ! Time step 482 INTEGER, INTENT(IN) :: kpi ! Model grid parameters 483 INTEGER, INTENT(IN) :: kpj 484 INTEGER, INTENT(IN) :: kit000 ! Number of the first time step 485 ! (kit000-1 = restart time) 486 INTEGER, INTENT(IN) :: k2dint ! Horizontal interpolation type (see header) 493 487 REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 494 488 & psshn, & ! Model SSH field … … 496 490 497 491 !! * Local declarations 498 INTEGER :: & 499 & ji, & 500 & jj, & 501 & jobs, & 502 & inrc, & 503 & isla, & 504 & iobs 505 REAL(KIND=wp) :: & 506 & zlam, & 507 & zphi 492 INTEGER :: ji 493 INTEGER :: jj 494 INTEGER :: jobs 495 INTEGER :: inrc 496 INTEGER :: isla 497 INTEGER :: iobs 498 REAL(KIND=wp) :: zlam 499 REAL(KIND=wp) :: zphi 508 500 REAL(KIND=wp) :: zext(1), zobsmask(1) 509 501 REAL(kind=wp), DIMENSION(2,2,1) :: & … … 524 516 inrc = kt - kit000 + 2 525 517 isla = sladatqc%nsstp(inrc) 526 518 527 519 ! Get the data for interpolation 528 520 … … 653 645 TYPE(obs_surf), INTENT(INOUT) :: & 654 646 & sstdatqc ! Subset of surface data not failing screening 655 INTEGER, INTENT(IN) :: & 656 & kt, & ! Time step 657 & kpi, & ! Model grid parameters 658 & kpj, & 659 & kit000, & ! Number of the first time step 660 ! (kit000-1 = restart time) 661 & k2dint ! Horizontal interpolation type (see header) 647 INTEGER, INTENT(IN) :: kt ! Time step 648 INTEGER, INTENT(IN) :: kpi ! Model grid parameters 649 INTEGER, INTENT(IN) :: kpj 650 INTEGER, INTENT(IN) :: kit000 ! Number of the first time step 651 ! (kit000-1 = restart time) 652 INTEGER, INTENT(IN) :: k2dint ! Horizontal interpolation type (see header) 662 653 REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 663 654 & psstn, & ! Model SST field … … 665 656 666 657 !! * Local declarations 667 INTEGER :: & 668 & ji, & 669 & jj, & 670 & jobs, & 671 & inrc, & 672 & isst, & 673 & iobs 674 REAL(KIND=wp) :: & 675 & zlam, & 676 & zphi 658 INTEGER :: ji 659 INTEGER :: jj 660 INTEGER :: jobs 661 INTEGER :: inrc 662 INTEGER :: isst 663 INTEGER :: iobs 664 REAL(KIND=wp) :: zlam 665 REAL(KIND=wp) :: zphi 677 666 REAL(KIND=wp) :: zext(1), zobsmask(1) 678 667 REAL(kind=wp), DIMENSION(2,2,1) :: & … … 838 827 839 828 !! * Arguments 840 TYPE(obs_surf), INTENT(INOUT) :: & 841 & seaicedatqc ! Subset of surface data not failing screening 842 INTEGER, INTENT(IN) :: & 843 & kt, & ! Time step 844 & kpi, & ! Model grid parameters 845 & kpj, & 846 & kit000, & ! Number of the first time step 847 ! (kit000-1 = restart time) 848 & k2dint ! Horizontal interpolation type (see header) 829 TYPE(obs_surf), INTENT(INOUT) :: seaicedatqc ! Subset of surface data not failing screening 830 INTEGER, INTENT(IN) :: kt ! Time step 831 INTEGER, INTENT(IN) :: kpi ! Model grid parameters 832 INTEGER, INTENT(IN) :: kpj 833 INTEGER, INTENT(IN) :: kit000 ! Number of the first time step 834 ! (kit000-1 = restart time) 835 INTEGER, INTENT(IN) :: k2dint ! Horizontal interpolation type (see header) 849 836 REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 850 837 & pseaicen, & ! Model sea ice field … … 852 839 853 840 !! * Local declarations 854 INTEGER :: & 855 & ji, & 856 & jj, & 857 & jobs, & 858 & inrc, & 859 & iseaice,& 860 & iobs 841 INTEGER :: ji 842 INTEGER :: jj 843 INTEGER :: jobs 844 INTEGER :: inrc 845 INTEGER :: iseaice 846 INTEGER :: iobs 861 847 862 REAL(KIND=wp) :: & 863 & zlam, & 864 & zphi 848 REAL(KIND=wp) :: zlam 849 REAL(KIND=wp) :: zphi 865 850 REAL(KIND=wp) :: zext(1), zobsmask(1) 866 851 REAL(kind=wp), DIMENSION(2,2,1) :: & … … 1001 986 TYPE(obs_prof), INTENT(INOUT) :: & 1002 987 & prodatqc ! Subset of profile data not failing screening 1003 INTEGER, INTENT(IN) :: & 1004 & kt, & ! Time step 1005 & kpi, & ! Model grid parameters 1006 & kpj, & 1007 & kpk, & 1008 & kit000, & ! Number of the first time step 1009 ! (kit000-1 = restart time) 1010 & k1dint, & ! Vertical interpolation type (see header) 1011 & k2dint, & ! Horizontal interpolation type (see header) 1012 & kdaystp ! Number of time steps per day 988 INTEGER, INTENT(IN) :: kt ! Time step 989 INTEGER, INTENT(IN) :: kpi ! Model grid parameters 990 INTEGER, INTENT(IN) :: kpj 991 INTEGER, INTENT(IN) :: kpk 992 INTEGER, INTENT(IN) :: kit000 ! Number of the first time step 993 ! (kit000-1 = restart time) 994 INTEGER, INTENT(IN) :: k1dint ! Vertical interpolation type (see header) 995 INTEGER, INTENT(IN) :: k2dint ! Horizontal interpolation type (see header) 996 INTEGER, INTENT(IN) :: kdaystp ! Number of time steps per day 1013 997 REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: & 1014 998 & pun, & ! Model zonal component of velocity … … 1018 1002 REAL(KIND=wp), INTENT(IN), DIMENSION(kpk) :: & 1019 1003 & pgdept ! Model array of depth levels 1020 LOGICAL, INTENT(IN) :: & 1021 & ld_dailyav 1004 LOGICAL, INTENT(IN) :: ld_dailyav 1022 1005 1023 1006 !! * Local declarations 1024 INTEGER :: & 1025 & ji, & 1026 & jj, & 1027 & jk, & 1028 & jobs, & 1029 & inrc, & 1030 & ipro, & 1031 & idayend,& 1032 & ista, & 1033 & iend, & 1034 & iobs 1007 INTEGER :: ji 1008 INTEGER :: jj 1009 INTEGER :: jk 1010 INTEGER :: jobs 1011 INTEGER :: inrc 1012 INTEGER :: ipro 1013 INTEGER :: idayend 1014 INTEGER :: ista 1015 INTEGER :: iend 1016 INTEGER :: iobs 1035 1017 INTEGER, DIMENSION(imaxavtypes) :: & 1036 1018 & idailyavtypes 1037 REAL(KIND=wp) :: & 1038 & zlam, & 1039 & zphi, & 1040 & zdaystp 1019 REAL(KIND=wp) :: zlam 1020 REAL(KIND=wp) :: zphi 1021 REAL(KIND=wp) :: zdaystp 1041 1022 REAL(KIND=wp), DIMENSION(kpk) :: & 1042 1023 & zobsmask, & … … 1305 1286 ENDIF 1306 1287 1307 END DO1288 END DO 1308 1289 1309 1290 ! Deallocate the data for interpolation -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_prep.F90
r2001 r2074 71 71 & nproc 72 72 !! * Arguments 73 TYPE(obs_prof), INTENT(INOUT) :: & 74 & profdata,& ! Full set of profile data 75 & prodatqc ! Subset of profile data not failing screening 76 LOGICAL, INTENT(IN) :: & 77 & ld_t3d, & ! Switch for temperature 78 & ld_s3d, & ! Switch for salinity 79 & ld_nea ! Switch for rejecting observation near land 73 TYPE(obs_prof), INTENT(INOUT) :: profdata ! Full set of profile data 74 TYPE(obs_prof), INTENT(INOUT) :: prodatqc ! Subset of profile data not failing screening 75 LOGICAL, INTENT(IN) :: ld_t3d ! Switch for temperature 76 LOGICAL, INTENT(IN) :: ld_s3d ! Switch for salinity 77 LOGICAL, INTENT(IN) :: ld_nea ! Switch for rejecting observation near land 80 78 INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 81 79 & kdailyavtypes! Types for daily averages 82 !! * Local declarations 83 INTEGER :: & 84 & iyea0, & ! Initial date 85 & imon0, & ! - (year, month, day, hour, minute) 86 & iday0, & 87 & ihou0, & 88 & imin0 89 INTEGER :: & 90 & icycle, & ! Current assimilation cycle 91 ! Counters for observations that 92 & iotdobs, & ! - outside time domain 93 & iosdtobs, & ! - outside space domain (temperature) 94 & iosdsobs, & ! - outside space domain (salinity) 95 & ilantobs, & ! - within a model land cell (temperature) 96 & ilansobs, & ! - within a model land cell (salinity) 97 & inlatobs, & ! - close to land (temperature) 98 & inlasobs, & ! - close to land (salinity) 99 & igrdobs, & ! - fail the grid search 100 ! Global counters for observations that 101 & iotdobsmpp, & ! - outside time domain 102 & iosdtobsmpp, & ! - outside space domain (temperature) 103 & iosdsobsmpp, & ! - outside space domain (salinity) 104 & ilantobsmpp, & ! - within a model land cell (temperature) 105 & ilansobsmpp, & ! - within a model land cell (salinity) 106 & inlatobsmpp, & ! - close to land (temperature) 107 & inlasobsmpp, & ! - close to land (salinity) 108 & igrdobsmpp ! - fail the grid search 109 TYPE(obs_prof_valid) :: & 110 & llvalid ! Profile selection 80 !! * Local declarations 81 INTEGER :: iyea0 ! Initial date 82 INTEGER :: imon0 ! - (year, month, day, hour, minute) 83 INTEGER :: iday0 84 INTEGER :: ihou0 85 INTEGER :: imin0 86 INTEGER :: icycle ! Current assimilation cycle 87 ! Counters for observations that 88 INTEGER :: iotdobs ! - outside time domain 89 INTEGER :: iosdtobs ! - outside space domain (temperature) 90 INTEGER :: iosdsobs ! - outside space domain (salinity) 91 INTEGER :: ilantobs ! - within a model land cell (temperature) 92 INTEGER :: ilansobs ! - within a model land cell (salinity) 93 INTEGER :: inlatobs ! - close to land (temperature) 94 INTEGER :: inlasobs ! - close to land (salinity) 95 INTEGER :: igrdobs ! - fail the grid search 96 ! Global counters for observations that 97 INTEGER :: iotdobsmpp ! - outside time domain 98 INTEGER :: iosdtobsmpp ! - outside space domain (temperature) 99 INTEGER :: iosdsobsmpp ! - outside space domain (salinity) 100 INTEGER :: ilantobsmpp ! - within a model land cell (temperature) 101 INTEGER :: ilansobsmpp ! - within a model land cell (salinity) 102 INTEGER :: inlatobsmpp ! - close to land (temperature) 103 INTEGER :: inlasobsmpp ! - close to land (salinity) 104 INTEGER :: igrdobsmpp ! - fail the grid search 105 TYPE(obs_prof_valid) :: llvalid ! Profile selection 111 106 TYPE(obs_prof_valid), DIMENSION(profdata%nvar) :: & 112 & llvvalid ! T,S selection 113 INTEGER :: & 114 & jvar, & ! Variable loop variable 115 & jobs, & ! Obs. loop variable 116 & jstp, & ! Time loop variable 117 & inrc ! Time index variable 107 & llvvalid ! T,S selection 108 INTEGER :: jvar ! Variable loop variable 109 INTEGER :: jobs ! Obs. loop variable 110 INTEGER :: jstp ! Time loop variable 111 INTEGER :: inrc ! Time index variable 118 112 119 113 IF(lwp) WRITE(numout,*)'obs_pre_pro : Preparing the profile observations...' … … 308 302 & prodatqc%npvsta(jobs,jvar) + 1 ) 309 303 ENDIF 310 END DO311 END DO304 END DO 305 END DO 312 306 313 307 … … 318 312 & prodatqc%nvstpmpp(:,jvar), & 319 313 & nitend - nit000 + 2 ) 320 END DO314 END DO 321 315 322 316 IF ( lwp ) THEN … … 360 354 & nproc 361 355 !! * Arguments 362 TYPE(obs_surf), INTENT(INOUT) :: & 363 & sladata, & ! Full set of SLA data 364 & sladatqc ! Subset of SLA data not failing screening 365 LOGICAL, INTENT(IN) :: & 366 & ld_sla, & ! Switch for SLA data 367 & ld_nea ! Switch for rejecting observation near land 356 TYPE(obs_surf), INTENT(INOUT) :: sladata ! Full set of SLA data 357 TYPE(obs_surf), INTENT(INOUT) :: sladatqc ! Subset of SLA data not failing screening 358 LOGICAL, INTENT(IN) :: ld_sla ! Switch for SLA data 359 LOGICAL, INTENT(IN) :: ld_nea ! Switch for rejecting observation near land 368 360 !! * Local declarations 369 INTEGER :: & 370 & iyea0, & ! Initial date 371 & imon0, & ! - (year, month, day, hour, minute) 372 & iday0, & 373 & ihou0, & 374 & imin0 375 INTEGER :: & 376 & icycle, & ! Current assimilation cycle 361 INTEGER :: iyea0 ! Initial date 362 INTEGER :: imon0 ! - (year, month, day, hour, minute) 363 INTEGER :: iday0 364 INTEGER :: ihou0 365 INTEGER :: imin0 366 INTEGER :: icycle ! Current assimilation cycle 377 367 ! Counters for observations that 378 & iotdobs, &! - outside time domain379 & iosdsobs, &! - outside space domain380 & ilansobs, &! - within a model land cell381 & inlasobs, &! - close to land382 & igrdobs, &! - fail the grid search368 INTEGER :: iotdobs ! - outside time domain 369 INTEGER :: iosdsobs ! - outside space domain 370 INTEGER :: ilansobs ! - within a model land cell 371 INTEGER :: inlasobs ! - close to land 372 INTEGER :: igrdobs ! - fail the grid search 383 373 ! Global counters for observations that 384 & iotdobsmpp, &! - outside time domain385 & iosdsobsmpp, &! - outside space domain386 & ilansobsmpp, &! - within a model land cell387 & inlasobsmpp, &! - close to land388 & igrdobsmpp! - fail the grid search374 INTEGER :: iotdobsmpp ! - outside time domain 375 INTEGER :: iosdsobsmpp ! - outside space domain 376 INTEGER :: ilansobsmpp ! - within a model land cell 377 INTEGER :: inlasobsmpp ! - close to land 378 INTEGER :: igrdobsmpp ! - fail the grid search 389 379 LOGICAL, DIMENSION(:), ALLOCATABLE :: & 390 380 & llvalid ! SLA data selection 391 INTEGER :: & 392 & jobs, & ! Obs. loop variable 393 & jstp, & ! Time loop variable 394 & inrc ! Time index variable 381 INTEGER :: jobs ! Obs. loop variable 382 INTEGER :: jstp ! Time loop variable 383 INTEGER :: inrc ! Time index variable 395 384 396 385 IF(lwp) WRITE(numout,*)'obs_pre_sla : Preparing the SLA observations...' … … 526 515 1998 FORMAT(10X,'---------',5X,'-----------------') 527 516 1999 FORMAT(10X,I9,5X,I17) 528 517 529 518 END SUBROUTINE obs_pre_sla 530 519 … … 553 542 & nproc 554 543 !! * Arguments 555 TYPE(obs_surf), INTENT(INOUT) :: & 556 & sstdata, & ! Full set of SST data 557 & sstdatqc ! Subset of SST data not failing screening 558 LOGICAL :: & 559 & ld_sst, & ! Switch for SST data 560 & ld_nea ! Switch for rejecting observation near land 544 TYPE(obs_surf), INTENT(INOUT) :: sstdata ! Full set of SST data 545 TYPE(obs_surf), INTENT(INOUT) :: sstdatqc ! Subset of SST data not failing screening 546 LOGICAL :: ld_sst ! Switch for SST data 547 LOGICAL :: ld_nea ! Switch for rejecting observation near land 561 548 !! * Local declarations 562 INTEGER :: & 563 & iyea0, & ! Initial date 564 & imon0, & ! - (year, month, day, hour, minute) 565 & iday0, & 566 & ihou0, & 567 & imin0 568 INTEGER :: & 569 & icycle, & ! Current assimilation cycle 549 INTEGER :: iyea0 ! Initial date 550 INTEGER :: imon0 ! - (year, month, day, hour, minute) 551 INTEGER :: iday0 552 INTEGER :: ihou0 553 INTEGER :: imin0 554 INTEGER :: icycle ! Current assimilation cycle 570 555 ! Counters for observations that 571 & iotdobs, &! - outside time domain572 & iosdsobs, &! - outside space domain573 & ilansobs, &! - within a model land cell574 & inlasobs, &! - close to land575 & igrdobs, &! - fail the grid search556 INTEGER :: iotdobs ! - outside time domain 557 INTEGER :: iosdsobs ! - outside space domain 558 INTEGER :: ilansobs ! - within a model land cell 559 INTEGER :: inlasobs ! - close to land 560 INTEGER :: igrdobs ! - fail the grid search 576 561 ! Global counters for observations that 577 & iotdobsmpp, &! - outside time domain578 & iosdsobsmpp, &! - outside space domain579 & ilansobsmpp, &! - within a model land cell580 & inlasobsmpp, &! - close to land581 & igrdobsmpp! - fail the grid search562 INTEGER :: iotdobsmpp ! - outside time domain 563 INTEGER :: iosdsobsmpp ! - outside space domain 564 INTEGER :: ilansobsmpp ! - within a model land cell 565 INTEGER :: inlasobsmpp ! - close to land 566 INTEGER :: igrdobsmpp ! - fail the grid search 582 567 LOGICAL, DIMENSION(:), ALLOCATABLE :: & 583 568 & llvalid ! SST data selection 584 INTEGER :: & 585 & jobs, & ! Obs. loop variable 586 & jstp, & ! Time loop variable 587 & inrc ! Time index variable 569 INTEGER :: jobs ! Obs. loop variable 570 INTEGER :: jstp ! Time loop variable 571 INTEGER :: inrc ! Time index variable 588 572 589 573 IF(lwp) WRITE(numout,*)'obs_pre_sst : Preparing the SST observations...' … … 743 727 & nproc 744 728 !! * Arguments 745 TYPE(obs_surf), INTENT(INOUT) :: & 746 & seaicedata, & ! Full set of Sea Ice data 747 & seaicedatqc ! Subset of sea ice data not failing screening 748 LOGICAL :: & 749 & ld_seaice, & ! Switch for sea ice data 750 & ld_nea ! Switch for rejecting observation near land 729 TYPE(obs_surf), INTENT(INOUT) :: seaicedata ! Full set of Sea Ice data 730 TYPE(obs_surf), INTENT(INOUT) :: seaicedatqc ! Subset of sea ice data not failing screening 731 LOGICAL :: ld_seaice ! Switch for sea ice data 732 LOGICAL :: ld_nea ! Switch for rejecting observation near land 751 733 !! * Local declarations 752 INTEGER :: & 753 & iyea0, & ! Initial date 754 & imon0, & ! - (year, month, day, hour, minute) 755 & iday0, & 756 & ihou0, & 757 & imin0 758 INTEGER :: & 759 & icycle, & ! Current assimilation cycle 734 INTEGER :: iyea0 ! Initial date 735 INTEGER :: imon0 ! - (year, month, day, hour, minute) 736 INTEGER :: iday0 737 INTEGER :: ihou0 738 INTEGER :: imin0 739 INTEGER :: icycle ! Current assimilation cycle 760 740 ! Counters for observations that 761 & iotdobs, &! - outside time domain762 & iosdsobs, &! - outside space domain763 & ilansobs, &! - within a model land cell764 & inlasobs, &! - close to land765 & igrdobs, &! - fail the grid search741 INTEGER :: iotdobs ! - outside time domain 742 INTEGER :: iosdsobs ! - outside space domain 743 INTEGER :: ilansobs ! - within a model land cell 744 INTEGER :: inlasobs ! - close to land 745 INTEGER :: igrdobs ! - fail the grid search 766 746 ! Global counters for observations that 767 & iotdobsmpp, &! - outside time domain768 & iosdsobsmpp, &! - outside space domain769 & ilansobsmpp, &! - within a model land cell770 & inlasobsmpp, &! - close to land771 & igrdobsmpp! - fail the grid search747 INTEGER :: iotdobsmpp ! - outside time domain 748 INTEGER :: iosdsobsmpp ! - outside space domain 749 INTEGER :: ilansobsmpp ! - within a model land cell 750 INTEGER :: inlasobsmpp ! - close to land 751 INTEGER :: igrdobsmpp ! - fail the grid search 772 752 LOGICAL, DIMENSION(:), ALLOCATABLE :: & 773 & llvalid ! sea ice data selection 774 INTEGER :: & 775 & jobs, & ! Obs. loop variable 776 & jstp, & ! Time loop variable 777 & inrc ! Time index variable 753 & llvalid ! data selection 754 INTEGER :: jobs ! Obs. loop variable 755 INTEGER :: jstp ! Time loop variable 756 INTEGER :: inrc ! Time index variable 778 757 779 758 IF (lwp) WRITE(numout,*)'obs_pre_seaice : Preparing the sea ice observations...' … … 933 912 & nproc 934 913 !! * Arguments 935 TYPE(obs_prof), INTENT(INOUT) :: & 936 & profdata,& ! Full set of profile data 937 & prodatqc ! Subset of profile data not failing screening 938 LOGICAL, INTENT(IN) :: & 939 & ld_vel3d, & ! Switch for zonal and meridional velocity components 940 & ld_nea, & ! Switch for rejecting observation near land 941 & ld_dailyav ! Switch for daily average data 914 TYPE(obs_prof), INTENT(INOUT) :: profdata ! Full set of profile data 915 TYPE(obs_prof), INTENT(INOUT) :: prodatqc ! Subset of profile data not failing screening 916 LOGICAL, INTENT(IN) :: ld_vel3d ! Switch for zonal and meridional velocity components 917 LOGICAL, INTENT(IN) :: ld_nea ! Switch for rejecting observation near land 918 LOGICAL, INTENT(IN) :: ld_dailyav ! Switch for daily average data 942 919 !! * Local declarations 943 INTEGER :: & 944 & iyea0, & ! Initial date 945 & imon0, & ! - (year, month, day, hour, minute) 946 & iday0, & 947 & ihou0, & 948 & imin0 949 INTEGER :: & 950 & icycle, & ! Current assimilation cycle 920 INTEGER :: iyea0 ! Initial date 921 INTEGER :: imon0 ! - (year, month, day, hour, minute) 922 INTEGER :: iday0 923 INTEGER :: ihou0 924 INTEGER :: imin0 925 INTEGER :: icycle ! Current assimilation cycle 951 926 ! Counters for observations that 952 & iotdobs, &! - outside time domain953 & iosduobs, &! - outside space domain (zonal velocity component)954 & iosdvobs, &! - outside space domain (meridional velocity component)955 & ilanuobs, &! - within a model land cell (zonal velocity component)956 & ilanvobs, &! - within a model land cell (meridional velocity component)957 & inlauobs, &! - close to land (zonal velocity component)958 & inlavobs, &! - close to land (meridional velocity component)959 & igrdobs, &! - fail the grid search960 & iuvchku, &! - reject u if v rejected and vice versa961 & iuvchkv, &!927 INTEGER :: iotdobs ! - outside time domain 928 INTEGER :: iosduobs ! - outside space domain (zonal velocity component) 929 INTEGER :: iosdvobs ! - outside space domain (meridional velocity component) 930 INTEGER :: ilanuobs ! - within a model land cell (zonal velocity component) 931 INTEGER :: ilanvobs ! - within a model land cell (meridional velocity component) 932 INTEGER :: inlauobs ! - close to land (zonal velocity component) 933 INTEGER :: inlavobs ! - close to land (meridional velocity component) 934 INTEGER :: igrdobs ! - fail the grid search 935 INTEGER :: iuvchku ! - reject u if v rejected and vice versa 936 INTEGER :: iuvchkv ! 962 937 ! Global counters for observations that 963 & iotdobsmpp, & ! - outside time domain 964 & iosduobsmpp, & ! - outside space domain (zonal velocity component) 965 & iosdvobsmpp, & ! - outside space domain (meridional velocity component) 966 & ilanuobsmpp, & ! - within a model land cell (zonal velocity component) 967 & ilanvobsmpp, & ! - within a model land cell (meridional velocity component) 968 & inlauobsmpp, & ! - close to land (zonal velocity component) 969 & inlavobsmpp, & ! - close to land (meridional velocity component) 970 & igrdobsmpp, & ! - fail the grid search 971 & iuvchkumpp, & ! - reject u if v rejected and vice versa 972 & iuvchkvmpp ! 973 TYPE(obs_prof_valid) :: & 974 & llvalid ! Profile selection 938 INTEGER :: iotdobsmpp ! - outside time domain 939 INTEGER :: iosduobsmpp ! - outside space domain (zonal velocity component) 940 INTEGER :: iosdvobsmpp ! - outside space domain (meridional velocity component) 941 INTEGER :: ilanuobsmpp ! - within a model land cell (zonal velocity component) 942 INTEGER :: ilanvobsmpp ! - within a model land cell (meridional velocity component) 943 INTEGER :: inlauobsmpp ! - close to land (zonal velocity component) 944 INTEGER :: inlavobsmpp ! - close to land (meridional velocity component) 945 INTEGER :: igrdobsmpp ! - fail the grid search 946 INTEGER :: iuvchkumpp ! - reject u if v rejected and vice versa 947 INTEGER :: iuvchkvmpp ! 948 TYPE(obs_prof_valid) :: llvalid ! Profile selection 975 949 TYPE(obs_prof_valid), DIMENSION(profdata%nvar) :: & 976 950 & llvvalid ! U,V selection 977 INTEGER :: & 978 & jvar, & ! Variable loop variable 979 & jobs, & ! Obs. loop variable 980 & jstp, & ! Time loop variable 981 & inrc ! Time index variable 951 INTEGER :: jvar ! Variable loop variable 952 INTEGER :: jobs ! Obs. loop variable 953 INTEGER :: jstp ! Time loop variable 954 INTEGER :: inrc ! Time index variable 982 955 983 956 IF(lwp) WRITE(numout,*)'obs_pre_vel: Preparing the velocity profile data' … … 1180 1153 & prodatqc%npvsta(jobs,jvar) + 1 ) 1181 1154 ENDIF 1182 END DO1183 END DO1155 END DO 1156 END DO 1184 1157 1185 1158 … … 1190 1163 & prodatqc%nvstpmpp(:,jvar), & 1191 1164 & nitend - nit000 + 2 ) 1192 END DO1165 END DO 1193 1166 1194 1167 IF ( lwp ) THEN … … 1240 1213 & rhhmm 1241 1214 !! * Arguments 1242 INTEGER, INTENT(IN) :: & 1243 & kcycle, & ! Current cycle 1244 & kyea0, & ! Initial date coordinates 1245 & kmon0, & 1246 & kday0, & 1247 & khou0, & 1248 & kmin0, & 1249 & kobsno ! Number of observations 1250 INTEGER, INTENT(INOUT) :: & 1251 & kotdobs ! Number of observations failing time check 1215 INTEGER, INTENT(IN) :: kcycle ! Current cycle 1216 INTEGER, INTENT(IN) :: kyea0 ! Initial date coordinates 1217 INTEGER, INTENT(IN) :: kmon0 1218 INTEGER, INTENT(IN) :: kday0 1219 INTEGER, INTENT(IN) :: khou0 1220 INTEGER, INTENT(IN) :: kmin0 1221 INTEGER, INTENT(IN) :: kobsno ! Number of observations 1222 INTEGER, INTENT(INOUT) :: kotdobs ! Number of observations failing time check 1252 1223 INTEGER, DIMENSION(kobsno), INTENT(IN ) :: & 1253 1224 & kobsyea, & ! Observation time coordinates … … 1263 1234 1264 1235 !! * Local declarations 1265 INTEGER :: & 1266 & jyea, & 1267 & jmon, & 1268 & jday, & 1269 & jobs 1270 INTEGER :: & 1271 & iyeastr, & 1272 & iyeaend, & 1273 & imonstr, & 1274 & imonend, & 1275 & idaystr, & 1276 & idayend, & 1277 & iskip, & 1278 & idaystp 1279 REAL(KIND=wp) :: & 1280 & zminstp, & 1281 & zhoustp, & 1282 & zobsstp 1236 INTEGER :: jyea 1237 INTEGER :: jmon 1238 INTEGER :: jday 1239 INTEGER :: jobs 1240 INTEGER :: iyeastr 1241 INTEGER :: iyeaend 1242 INTEGER :: imonstr 1243 INTEGER :: imonend 1244 INTEGER :: idaystr 1245 INTEGER :: idayend 1246 INTEGER :: iskip 1247 INTEGER :: idaystp 1248 REAL(KIND=wp) :: zminstp 1249 REAL(KIND=wp) :: zhoustp 1250 REAL(KIND=wp) :: zobsstp 1283 1251 INTEGER, DIMENSION(12) :: imonth_len !: length in days of the months of the current year 1284 1252 … … 1373 1341 ENDIF 1374 1342 1375 END DO1343 END DO 1376 1344 1377 1345 END SUBROUTINE obs_coo_tim … … 1435 1403 !! * Modules used 1436 1404 !! * Arguments 1437 INTEGER, INTENT(IN) :: & 1438 & kcycle, & ! Current cycle 1439 & kyea0, & ! Initial date coordinates 1440 & kmon0, & 1441 & kday0, & 1442 & khou0, & 1443 & kmin0, & 1444 & kobsno ! Number of observations 1445 INTEGER, INTENT(INOUT) :: & 1446 & kotdobs ! Number of observations failing time check 1405 INTEGER, INTENT(IN) :: kcycle ! Current cycle 1406 INTEGER, INTENT(IN) :: kyea0 ! Initial date coordinates 1407 INTEGER, INTENT(IN) :: kmon0 1408 INTEGER, INTENT(IN) :: kday0 1409 INTEGER, INTENT(IN) :: khou0 1410 INTEGER, INTENT(IN) :: kmin0 1411 INTEGER, INTENT(IN) :: kobsno ! Number of observations 1412 INTEGER, INTENT(INOUT) :: kotdobs ! Number of observations failing time check 1447 1413 INTEGER, DIMENSION(kobsno), INTENT(IN ) :: & 1448 1414 & kobsyea, & ! Observation time coordinates … … 1459 1425 INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 1460 1426 & kdailyavtypes ! Types for daily averages 1461 LOGICAL, OPTIONAL :: & 1462 & ld_dailyav ! All types are daily averages 1427 LOGICAL, OPTIONAL :: ld_dailyav ! All types are daily averages 1463 1428 !! * Local declarations 1464 INTEGER :: & 1465 & jobs 1429 INTEGER :: jobs 1466 1430 1467 1431 !----------------------------------------------------------------------- … … 1492 1456 1493 1457 ENDIF 1494 END DO1458 END DO 1495 1459 ENDIF 1496 1460 … … 1512 1476 1513 1477 ENDIF 1514 END DO1478 END DO 1515 1479 ENDIF 1516 1480 ENDIF … … 1534 1498 !!---------------------------------------------------------------------- 1535 1499 !! * Arguments 1536 INTEGER, INTENT(IN) :: & 1537 & kobsno ! Number of observations 1500 INTEGER, INTENT(IN) :: kobsno ! Number of observations 1538 1501 INTEGER, DIMENSION(kobsno), INTENT(IN ) :: & 1539 1502 & kobsi, & ! i,j indeces previously computed 1540 1503 & kobsj 1541 INTEGER, INTENT(INOUT) :: & 1542 & kgrdobs ! Number of observations failing the check 1504 INTEGER, INTENT(INOUT) :: kgrdobs ! Number of observations failing the check 1543 1505 INTEGER, DIMENSION(kobsno), INTENT(INOUT) :: & 1544 1506 & kobsqc ! Quality control flag 1545 1507 1546 1508 !! * Local declarations 1547 INTEGER :: & 1548 & jobs ! Loop variable 1509 INTEGER :: jobs ! Loop variable 1549 1510 1550 1511 ! Flag if the grid search failed … … 1555 1516 kgrdobs = kgrdobs + 1 1556 1517 ENDIF 1557 END DO1518 END DO 1558 1519 1559 1520 END SUBROUTINE obs_coo_grd … … 1581 1542 1582 1543 !! * Arguments 1583 INTEGER, INTENT(IN) :: & 1584 & kobsno, & ! Total number of observations 1585 & kpi, & ! Number of grid points in (i,j) 1586 & kpj 1544 INTEGER, INTENT(IN) :: kobsno ! Total number of observations 1545 INTEGER, INTENT(IN) :: kpi ! Number of grid points in (i,j) 1546 INTEGER, INTENT(IN) :: kpj 1587 1547 INTEGER, DIMENSION(kobsno), INTENT(IN) :: & 1588 1548 & kobsi, & ! Observation (i,j) coordinates … … 1591 1551 & pobslam, & ! Observation (lon,lat) coordinates 1592 1552 & pobsphi 1593 REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(IN OUT) :: &1553 REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(IN) :: & 1594 1554 & plam, pphi ! Model (lon,lat) coordinates 1595 1555 REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(IN) :: & … … 1597 1557 INTEGER, DIMENSION(kobsno), INTENT(INOUT) :: & 1598 1558 & kobsqc ! Observation quality control 1599 INTEGER, INTENT(INOUT) :: & 1600 & kosdobs, & ! Observations outside space domain 1601 & klanobs, & ! Observations within a model land cell 1602 & knlaobs ! Observations near land 1603 LOGICAL, INTENT(IN) :: & 1604 & ld_nea ! Flag observations near land 1559 INTEGER, INTENT(INOUT) :: kosdobs ! Observations outside space domain 1560 INTEGER, INTENT(INOUT) :: klanobs ! Observations within a model land cell 1561 INTEGER, INTENT(INOUT) :: knlaobs ! Observations near land 1562 LOGICAL, INTENT(IN) :: ld_nea ! Flag observations near land 1605 1563 !! * Local declarations 1606 1564 REAL(KIND=wp), DIMENSION(2,2,kobsno) :: & 1607 1565 & zgmsk ! Grid mask 1566 REAL(KIND=wp), DIMENSION(2,2,kobsno) :: & 1567 & zglam, & ! Model longitude at grid points 1568 & zgphi ! Model latitude at grid points 1608 1569 INTEGER, DIMENSION(2,2,kobsno) :: & 1609 1570 & igrdi, & ! Grid i,j 1610 1571 & igrdj 1611 INTEGER :: & 1612 & jobs 1572 LOGICAL :: lgridobs ! Is observation on a model grid point. 1573 INTEGER :: iig, ijg ! i,j of observation on model grid point. 1574 INTEGER :: jobs, ji, jj 1613 1575 1614 1576 ! Get grid point indices … … 1642 1604 ENDIF 1643 1605 1644 END DO1606 END DO 1645 1607 1646 1608 CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, pmask, zgmsk ) 1609 CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, plam, zglam ) 1610 CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, pphi, zgphi ) 1647 1611 1648 1612 DO jobs = 1, kobsno … … 1667 1631 CYCLE 1668 1632 ENDIF 1669 1633 1634 ! Check if this observation is on a grid point 1635 1636 lgridobs = .FALSE. 1637 iig = -1 1638 ijg = -1 1639 DO jj = 1, 2 1640 DO ji = 1, 2 1641 IF ( ( ABS( zgphi(ji,jj,jobs) - pobsphi(jobs) ) < 1.0e-6_wp ) & 1642 & .AND. & 1643 & ( ABS( zglam(ji,jj,jobs) - pobslam(jobs) ) < 1.0e-6_wp ) & 1644 & ) THEN 1645 lgridobs = .TRUE. 1646 iig = ji 1647 ijg = jj 1648 ENDIF 1649 END DO 1650 END DO 1651 1652 ! For observations on the grid reject them if their are at 1653 ! a masked point 1654 1655 IF (lgridobs) THEN 1656 IF (zgmsk(iig,ijg,jobs) == 0.0_wp ) THEN 1657 kobsqc(jobs) = kobsqc(jobs) + 12 1658 klanobs = klanobs + 1 1659 CYCLE 1660 ENDIF 1661 ENDIF 1662 1670 1663 ! Flag if the observation falls is close to land 1671 1664 IF ( MINVAL( zgmsk(1:2,1:2,jobs) ) == 0.0_wp) THEN … … 1711 1704 1712 1705 !! * Arguments 1713 INTEGER, INTENT(IN) :: & 1714 & kprofno, & ! Number of profiles 1715 & kobsno, & ! Total number of observations 1716 & kpi, & ! Number of grid points in (i,j,k) 1717 & kpj, & 1718 & kpk 1706 INTEGER, INTENT(IN) :: kprofno ! Number of profiles 1707 INTEGER, INTENT(IN) :: kobsno ! Total number of observations 1708 INTEGER, INTENT(IN) :: kpi ! Number of grid points in (i,j,k) 1709 INTEGER, INTENT(IN) :: kpj 1710 INTEGER, INTENT(IN) :: kpk 1719 1711 INTEGER, DIMENSION(kprofno), INTENT(IN) :: & 1720 1712 & kpstart, & ! Start of individual profiles … … 1730 1722 REAL(KIND=wp), DIMENSION(kobsno), INTENT(INOUT) :: & 1731 1723 & pobsdep ! Observation depths 1732 REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(IN OUT) :: &1724 REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(IN) :: & 1733 1725 & plam, pphi ! Model (lon,lat) coordinates 1734 1726 REAL(KIND=wp), DIMENSION(kpk), INTENT(IN) :: & … … 1740 1732 INTEGER, DIMENSION(kobsno), INTENT(INOUT) :: & 1741 1733 & kobsqc ! Observation quality control 1742 INTEGER, INTENT(INOUT) :: & 1743 & kosdobs, & ! Observations outside space domain 1744 & klanobs, & ! Observations within a model land cell 1745 & knlaobs ! Observations near land 1746 LOGICAL, INTENT(IN) :: & 1747 & ld_nea ! Flag observations near land 1734 INTEGER, INTENT(INOUT) :: kosdobs ! Observations outside space domain 1735 INTEGER, INTENT(INOUT) :: klanobs ! Observations within a model land cell 1736 INTEGER, INTENT(INOUT) :: knlaobs ! Observations near land 1737 LOGICAL, INTENT(IN) :: ld_nea ! Flag observations near land 1748 1738 !! * Local declarations 1749 1739 REAL(KIND=wp), DIMENSION(2,2,kpk,kprofno) :: & 1750 1740 & zgmsk ! Grid mask 1741 REAL(KIND=wp), DIMENSION(2,2,kprofno) :: & 1742 & zglam, & ! Model longitude at grid points 1743 & zgphi ! Model latitude at grid points 1751 1744 INTEGER, DIMENSION(2,2,kprofno) :: & 1752 1745 & igrdi, & ! Grid i,j 1753 1746 & igrdj 1754 INTEGER :: & 1755 & jobs, jobsp, jk 1747 LOGICAL :: lgridobs ! Is observation on a model grid point. 1748 INTEGER :: iig, ijg ! i,j of observation on model grid point. 1749 INTEGER :: jobs, jobsp, jk, ji, jj 1756 1750 1757 1751 ! Get grid point indices … … 1785 1779 ENDIF 1786 1780 1787 END DO1781 END DO 1788 1782 1789 1783 CALL obs_int_comm_3d( 2, 2, kprofno, kpk, igrdi, igrdj, pmask, zgmsk ) 1784 CALL obs_int_comm_2d( 2, 2, kprofno, igrdi, igrdj, plam, zglam ) 1785 CALL obs_int_comm_2d( 2, 2, kprofno, igrdi, igrdj, pphi, zgphi ) 1790 1786 1791 1787 DO jobs = 1, kprofno … … 1793 1789 ! Skip bad profiles 1794 1790 IF ( kpobsqc(jobs) >= 10 ) CYCLE 1791 1792 ! Check if this observation is on a grid point 1793 1794 lgridobs = .FALSE. 1795 iig = -1 1796 ijg = -1 1797 DO jj = 1, 2 1798 DO ji = 1, 2 1799 IF ( ( ABS( zgphi(ji,jj,jobs) - pobsphi(jobs) ) < 1.0e-6_wp ) & 1800 & .AND. & 1801 & ( ABS( zglam(ji,jj,jobs) - pobslam(jobs) ) < 1.0e-6_wp ) & 1802 & ) THEN 1803 lgridobs = .TRUE. 1804 iig = ji 1805 ijg = jj 1806 ENDIF 1807 END DO 1808 END DO 1809 1810 ! Reject observations 1795 1811 1796 1812 DO jobsp = kpstart(jobs), kpend(jobs) … … 1815 1831 CYCLE 1816 1832 ENDIF 1833 1834 ! For observations on the grid reject them if their are at 1835 ! a masked point 1836 1837 IF (lgridobs) THEN 1838 IF (zgmsk(iig,ijg,kobsk(jobsp)-1,jobs) == 0.0_wp ) THEN 1839 kobsqc(jobsp) = kobsqc(jobsp) + 12 1840 klanobs = klanobs + 1 1841 CYCLE 1842 ENDIF 1843 ENDIF 1817 1844 1818 1845 ! Flag if the observation falls is close to land … … 1828 1855 ENDIF 1829 1856 1830 END DO1831 END DO1857 END DO 1858 END DO 1832 1859 1833 1860 END SUBROUTINE obs_coo_spc_3d … … 1850 1877 !! * Modules used 1851 1878 !! * Arguments 1852 TYPE(obs_prof), INTENT(INOUT) :: & 1853 & profdata ! Profile data 1879 TYPE(obs_prof), INTENT(INOUT) :: profdata ! Profile data 1854 1880 !! * Local declarations 1855 INTEGER :: & 1856 & jprof, & 1857 & jvar, & 1858 & jobs 1881 INTEGER :: jprof 1882 INTEGER :: jvar 1883 INTEGER :: jobs 1859 1884 1860 1885 ! Loop over profiles … … 1872 1897 & profdata%var(jvar)%nvqc(jobs) + 26 1873 1898 1874 END DO1875 1876 END DO1899 END DO 1900 1901 END DO 1877 1902 1878 1903 ENDIF 1879 1904 1880 END DO1905 END DO 1881 1906 1882 1907 END SUBROUTINE obs_pro_rej … … 1899 1924 !! * Modules used 1900 1925 !! * Arguments 1901 TYPE(obs_prof), INTENT(INOUT) :: & 1902 & profdata ! Profile data 1903 INTEGER, INTENT(INOUT) :: & 1904 & knumu , & ! Number of u rejected 1905 & knumv ! Number of v rejected 1926 TYPE(obs_prof), INTENT(INOUT) :: profdata ! Profile data 1927 INTEGER, INTENT(INOUT) :: knumu ! Number of u rejected 1928 INTEGER, INTENT(INOUT) :: knumv ! Number of v rejected 1906 1929 !! * Local declarations 1907 INTEGER :: & 1908 & jprof, & 1909 & jvar, & 1910 & jobs 1930 INTEGER :: jprof 1931 INTEGER :: jvar 1932 INTEGER :: jobs 1911 1933 1912 1934 ! Loop over profiles … … 1935 1957 ENDIF 1936 1958 1937 END DO1959 END DO 1938 1960 1939 END DO1961 END DO 1940 1962 1941 1963 END SUBROUTINE obs_uv_rej -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_prof_io.h90
r2001 r2074 21 21 LOGICAL :: ldgrid ! Save grid info in data structure 22 22 !! * Local declarations 23 INTEGER :: & 24 & iobs, & ! Number of observations 25 & ilev ! Number of levels 26 INTEGER :: & 27 & i_file_id, & 28 & i_obs_id, & 29 & i_lev_id, & 30 & i_phi_id, & 31 & i_lam_id, & 32 & i_depth_id, & 33 & i_var_id, & 34 & i_pl_num_id, & 35 & i_reference_date_time_id, & 36 & i_format_version_id, & 37 & i_juld_id, & 38 & i_data_type_id, & 39 & i_wmo_inst_type_id, & 40 & i_qc_var_id, & 41 & i_dc_ref_id, & 42 & i_qc_flag_id 43 CHARACTER(LEN=40) :: & 44 & cl_fld_lam, & 45 & cl_fld_phi, & 46 & cl_fld_depth, & 47 & cl_fld_var_tp, & 48 & cl_fld_var_s, & 49 & cl_fld_var_ti, & 50 & cl_fld_var_juld_qc, & 51 & cl_fld_var_pos_qc, & 52 & cl_fld_var_depth_qc, & 53 & cl_fld_var_qc_t, & 54 & cl_fld_var_qc_s, & 55 & cl_fld_var_prof_qc_t, & 56 & cl_fld_var_prof_qc_s, & 57 & cl_fld_reference_date_time, & 58 & cl_fld_juld, & 59 & cl_fld_data_type, & 60 & cl_fld_pl_num, & 61 & cl_fld_format_version, & 62 & cl_fld_wmo_inst_type, & 63 & cl_fld_qc_flags_profiles, & 64 & cl_fld_qc_flags_levels 65 66 CHARACTER(LEN=14), PARAMETER :: & 67 & cl_name = 'read_enactfile' 68 CHARACTER(LEN=16) :: & 69 & cl_data_type = '' 70 CHARACTER(LEN=4 ) :: & 71 & cl_format_version = '' 72 INTEGER, DIMENSION(1) :: & 73 & istart1, icount1 74 INTEGER, DIMENSION(2) :: & 75 & istart2, icount2 76 CHARACTER(len=imaxlev) :: & 77 & clqc 78 CHARACTER(len=1) :: & 79 & cqc 80 INTEGER :: & 81 & ji, jk 82 INTEGER, ALLOCATABLE, DIMENSION(:) :: & 83 & iqc1 84 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: & 85 & iqc2 23 INTEGER :: iobs ! Number of observations 24 INTEGER :: ilev ! Number of levels 25 INTEGER :: i_file_id 26 INTEGER :: i_obs_id 27 INTEGER :: i_lev_id 28 INTEGER :: i_phi_id 29 INTEGER :: i_lam_id 30 INTEGER :: i_depth_id 31 INTEGER :: i_var_id 32 INTEGER :: i_pl_num_id 33 INTEGER :: i_reference_date_time_id 34 INTEGER :: i_format_version_id 35 INTEGER :: i_juld_id 36 INTEGER :: i_data_type_id 37 INTEGER :: i_wmo_inst_type_id 38 INTEGER :: i_qc_var_id 39 INTEGER :: i_dc_ref_id 40 INTEGER :: i_qc_flag_id 41 CHARACTER(LEN=40) :: cl_fld_lam 42 CHARACTER(LEN=40) :: cl_fld_phi 43 CHARACTER(LEN=40) :: cl_fld_depth 44 CHARACTER(LEN=40) :: cl_fld_var_tp 45 CHARACTER(LEN=40) :: cl_fld_var_s 46 CHARACTER(LEN=40) :: cl_fld_var_ti 47 CHARACTER(LEN=40) :: cl_fld_var_juld_qc 48 CHARACTER(LEN=40) :: cl_fld_var_pos_qc 49 CHARACTER(LEN=40) :: cl_fld_var_depth_qc 50 CHARACTER(LEN=40) :: cl_fld_var_qc_t 51 CHARACTER(LEN=40) :: cl_fld_var_qc_s 52 CHARACTER(LEN=40) :: cl_fld_var_prof_qc_t 53 CHARACTER(LEN=40) :: cl_fld_var_prof_qc_s 54 CHARACTER(LEN=40) :: cl_fld_reference_date_time 55 CHARACTER(LEN=40) :: cl_fld_juld 56 CHARACTER(LEN=40) :: cl_fld_data_type 57 CHARACTER(LEN=40) :: cl_fld_pl_num 58 CHARACTER(LEN=40) :: cl_fld_format_version 59 CHARACTER(LEN=40) :: cl_fld_wmo_inst_type 60 CHARACTER(LEN=40) :: cl_fld_qc_flags_profiles 61 CHARACTER(LEN=40) :: cl_fld_qc_flags_levels 62 63 CHARACTER(LEN=14), PARAMETER :: cl_name = 'read_enactfile' 64 CHARACTER(LEN=16) :: cl_data_type = '' 65 CHARACTER(LEN=4 ) :: cl_format_version = '' 66 INTEGER, DIMENSION(1) :: istart1, icount1 67 INTEGER, DIMENSION(2) :: istart2, icount2 68 CHARACTER(len=imaxlev) :: clqc 69 CHARACTER(len=1) :: cqc 70 INTEGER :: ji, jk 71 INTEGER, ALLOCATABLE, DIMENSION(:) :: iqc1 72 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: iqc2 86 73 87 74 !----------------------------------------------------------------------- … … 207 194 DO jk = 1, ilev 208 195 inpfile%ivlqc(jk,ji,1) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' ) 209 END DO210 END DO196 END DO 197 END DO 211 198 CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_qc_s, i_qc_var_id ), & 212 199 & cl_name, __LINE__ ) … … 218 205 DO jk = 1, ilev 219 206 inpfile%ivlqc(jk,ji,2) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' ) 220 END DO221 END DO207 END DO 208 END DO 222 209 ! No depth QC in files 223 210 DO ji = 1, iobs … … 225 212 inpfile%idqc(jk,ji) = 1 226 213 inpfile%idqcf(:,jk,ji) = 0 227 END DO228 END DO214 END DO 215 END DO 229 216 230 217 CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_t, i_qc_var_id ), & … … 236 223 & cl_name, __LINE__ ) 237 224 inpfile%ivqc(ji,1) = IACHAR( cqc ) - IACHAR( '0' ) 238 END DO225 END DO 239 226 CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_s, i_qc_var_id ), & 240 227 & cl_name, __LINE__ ) … … 245 232 & cl_name, __LINE__ ) 246 233 inpfile%ivqc(ji,2) = IACHAR( cqc ) - IACHAR( '0' ) 247 END DO234 END DO 248 235 !! CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_juld_qc, i_qc_var_id ), & 249 236 !! & cl_name, __LINE__ ) … … 255 242 !! inpfile%itqc(ji) = IACHAR( cqc ) - IACHAR( '0' ) 256 243 !! inpfile%itqcf(:,ji) = 0 257 !! END DO244 !! END DO 258 245 ! Since the flags are not set in the ENACT files we reset them to 0 259 246 inpfile%itqc(:) = 1 … … 268 255 inpfile%ipqc(ji) = IACHAR( cqc ) - IACHAR( '0' ) 269 256 inpfile%ipqcf(:,ji) = 0 270 END DO257 END DO 271 258 DO ji = 1,iobs 272 259 inpfile%ioqc(ji) = MIN( inpfile%ivqc(ji,1), inpfile%ivqc(ji,2) ) 273 END DO260 END DO 274 261 IF ( nf90_inq_varid( i_file_id, cl_fld_qc_flags_profiles, i_qc_flag_id ) == nf90_noerr ) THEN 275 262 ALLOCATE( & … … 283 270 inpfile%ioqcf(2,ji) = 0 284 271 inpfile%ivqcf(2,ji,:) = 0 285 END DO272 END DO 286 273 DEALLOCATE( & 287 274 & iqc1 & … … 302 289 inpfile%ivlqcf(1,jk,ji,:) = iqc2(jk,ji) 303 290 inpfile%ivlqcf(2,jk,ji,:) = 0 304 END DO305 END DO291 END DO 292 END DO 306 293 DEALLOCATE( & 307 294 & iqc2 & … … 385 372 DO ji = 1, inpfile%nobs 386 373 inpfile%kindex(ji) = ji 387 END DO374 END DO 388 375 389 376 END SUBROUTINE read_enactfile … … 611 598 DO jk = 1, ilev 612 599 inpfile%ivlqc(jk,ji,1) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' ) 613 END DO614 END DO600 END DO 601 END DO 615 602 IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_s, i_qc_var_id ) == nf90_noerr ) THEN 616 603 DO ji = 1, iobs … … 621 608 DO jk = 1, ilev 622 609 inpfile%ivlqc(jk,ji,2) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' ) 623 END DO624 END DO610 END DO 611 END DO 625 612 ELSE 626 613 inpfile%ivlqc(:,:,2) = 4 … … 637 624 & cl_name, __LINE__ ) 638 625 inpfile%ivqc(ji,1) = IACHAR( cqc ) - IACHAR( '0' ) 639 END DO626 END DO 640 627 IF (lsal) THEN 641 628 CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_s, i_qc_var_id ), & … … 647 634 & cl_name, __LINE__ ) 648 635 inpfile%ivqc(ji,2) = IACHAR( cqc ) - IACHAR( '0' ) 649 END DO636 END DO 650 637 ELSE 651 638 inpfile%ivqc(:,2) = 4 … … 653 640 DO ji = 1,iobs 654 641 inpfile%ioqc(ji) = MIN( inpfile%ivqc(ji,1), inpfile%ivqc(ji,2) ) 655 END DO642 END DO 656 643 CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_pos_qc, i_qc_var_id ), & 657 644 & cl_name, __LINE__ ) … … 662 649 & cl_name, __LINE__ ) 663 650 inpfile%ipqc(ji) = IACHAR( cqc ) - IACHAR( '0' ) 664 END DO651 END DO 665 652 666 653 !--------------------------------------------------------------------- … … 693 680 DO jk = 1, ilev 694 681 inpfile%idqc(jk,ji) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' ) 695 END DO696 END DO682 END DO 683 END DO 697 684 ELSE 698 685 inpfile%pdep(:,:) = fbrmdi … … 712 699 DO jk = 1, ilev 713 700 ipresqc(jk,ji) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' ) 714 END DO715 END DO701 END DO 702 END DO 716 703 ELSE 717 704 zpres(:,:) = fbrmdi … … 771 758 DO ji = 1, inpfile%nobs 772 759 inpfile%kindex(ji) = ji 773 END DO760 END DO 774 761 775 762 !--------------------------------------------------------------------- … … 789 776 ENDIF 790 777 ENDIF 791 END DO778 END DO 792 779 ENDIF 793 END DO780 END DO 794 781 795 782 !--------------------------------------------------------------------- … … 806 793 ENDIF 807 794 ENDIF 808 END DO795 END DO 809 796 ENDIF 810 END DO797 END DO 811 798 812 799 !--------------------------------------------------------------------- … … 826 813 inpfile%pob(jk,ji,1) = fbrmdi 827 814 ENDIF 828 END DO829 END DO815 END DO 816 END DO 830 817 831 818 !--------------------------------------------------------------------- -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_profiles_def.F90
r2001 r2074 50 50 TYPE obs_prof_valid 51 51 52 LOGICAL, POINTER, DIMENSION(:) :: & 53 luse 52 LOGICAL, POINTER, DIMENSION(:) :: luse 54 53 55 54 END TYPE obs_prof_valid … … 92 91 ! Bookkeeping 93 92 94 INTEGER :: & 95 & nvar, & !: Number of variables 96 & next, & !: Number of extra fields 97 & nprof, & !: Total number of profiles within window. 98 & nstp, & !: Number of time steps 99 & npi, & !: Number of 3D grid points 100 & npj, & 101 & npk, & 102 & nprofup !: Observation counter used in obs_oper 93 INTEGER :: nvar !: Number of variables 94 INTEGER :: next !: Number of extra fields 95 INTEGER :: nprof !: Total number of profiles within window. 96 INTEGER :: nstp !: Number of time steps 97 INTEGER :: npi !: Number of 3D grid points 98 INTEGER :: npj 99 INTEGER :: npk 100 INTEGER :: nprofup !: Observation counter used in obs_oper 103 101 104 102 ! Bookkeeping arrays with sizes equal to number of variables … … 155 153 ! Arrays of variables 156 154 157 TYPE(obs_prof_var), POINTER, DIMENSION(:) :: & 158 & var 155 TYPE(obs_prof_var), POINTER, DIMENSION(:) :: var 159 156 160 157 ! Arrays with size equal to the number of time steps in the window … … 203 200 !!---------------------------------------------------------------------- 204 201 !! * Arguments 205 TYPE(obs_prof), INTENT(INOUT) :: & 206 & prof ! Profile data to be allocated 207 INTEGER, INTENT(IN) :: & 208 & kprof, & ! Number of profiles 209 & kvar, & ! Number of variables 210 & kext ! Number of extra fields within each variable 202 TYPE(obs_prof), INTENT(INOUT) :: prof ! Profile data to be allocated 203 INTEGER, INTENT(IN) :: kprof ! Number of profiles 204 INTEGER, INTENT(IN) :: kvar ! Number of variables 205 INTEGER, INTENT(IN) :: kext ! Number of extra fields within each variable 211 206 INTEGER, INTENT(IN), DIMENSION(kvar) :: & 212 207 & ko3dt ! Number of observations per variables 213 INTEGER, INTENT(IN) :: & 214 & kstp, & ! Number of time steps 215 & kpi, & ! Number of 3D grid points 216 & kpj, & 217 & kpk 208 INTEGER, INTENT(IN) :: kstp ! Number of time steps 209 INTEGER, INTENT(IN) :: kpi ! Number of 3D grid points 210 INTEGER, INTENT(IN) :: kpj 211 INTEGER, INTENT(IN) :: kpk 218 212 219 213 !!* Local variables 220 INTEGER :: & 221 & jvar, & 222 & ji 214 INTEGER :: jvar 215 INTEGER :: ji 223 216 224 217 ! Set bookkeeping variables … … 243 236 prof%nvprot (jvar) = ko3dt(jvar) 244 237 prof%nvprotmpp(jvar) = 0 245 END DO238 END DO 246 239 247 240 ! Allocate arrays of size number of profiles … … 303 296 IF ( ko3dt(jvar) >= 0 ) THEN 304 297 CALL obs_prof_alloc_var( prof, jvar, kext, ko3dt(jvar) ) 305 END 298 ENDIF 306 299 307 300 END DO … … 333 326 DO ji = 1, kprof 334 327 prof%npind(ji) = ji 335 END DO328 END DO 336 329 337 330 DO jvar = 1, kvar 338 331 DO ji = 1, ko3dt(jvar) 339 332 prof%var(jvar)%nvind(ji) = ji 340 END DO341 END DO333 END DO 334 END DO 342 335 343 336 ! Set defaults for number of observations per time step … … 471 464 !! ! 07-03 (K. Mogensen) Original code 472 465 !! * Arguments 473 TYPE(obs_prof), INTENT(INOUT) :: & 474 & prof ! Profile data to be allocated 475 INTEGER, INTENT(IN) :: & 476 & kvar, & ! Variable number 477 & kext, & ! Number of extra fields within each variable 478 & kobs ! Number of observations 466 TYPE(obs_prof), INTENT(INOUT) :: prof ! Profile data to be allocated 467 INTEGER, INTENT(IN) :: kvar ! Variable number 468 INTEGER, INTENT(IN) :: kext ! Number of extra fields within each variable 469 INTEGER, INTENT(IN) :: kobs ! Number of observations 479 470 480 471 ALLOCATE( & … … 513 504 !! ! 07-03 (K. Mogensen) Original code 514 505 !! * Arguments 515 TYPE(obs_prof), INTENT(INOUT) :: & 516 & prof ! Profile data to be allocated 517 INTEGER, INTENT(IN) :: & 518 & kvar ! Variable number 506 TYPE(obs_prof), INTENT(INOUT) :: prof ! Profile data to be allocated 507 INTEGER, INTENT(IN) :: kvar ! Variable number 519 508 520 509 DEALLOCATE( & … … 559 548 !!---------------------------------------------------------------------- 560 549 !! * Arguments 561 TYPE(obs_prof), INTENT(IN) :: & 562 & prof ! Original profile 563 TYPE(obs_prof), INTENT(INOUT) :: & 564 & newprof ! New profile with the copy of the data 565 LOGICAL :: & 566 & lallocate ! Allocate newprof data 567 INTEGER,INTENT(IN) :: & 568 & kumout ! Fortran unit for messages 550 TYPE(obs_prof), INTENT(IN) :: prof ! Original profile 551 TYPE(obs_prof), INTENT(INOUT) :: newprof ! New profile with the copy of the data 552 LOGICAL :: lallocate ! Allocate newprof data 553 INTEGER,INTENT(IN) :: kumout ! Fortran unit for messages 569 554 TYPE(obs_prof_valid), OPTIONAL, INTENT(in) :: & 570 555 & lvalid ! Valid profiles … … 573 558 574 559 !!* Local variables 575 INTEGER :: & 576 & inprof 560 INTEGER :: inprof 577 561 INTEGER, DIMENSION(prof%nvar) :: & 578 562 & invpro 579 INTEGER :: & 580 & jvar, & 581 & jext, & 582 & ji, & 583 & jj 584 LOGICAL :: & 585 & lfirst 563 INTEGER :: jvar 564 INTEGER :: jext 565 INTEGER :: ji 566 INTEGER :: jj 567 LOGICAL :: lfirst 586 568 TYPE(obs_prof_valid) :: & 587 569 & llvalid 588 570 TYPE(obs_prof_valid), DIMENSION(prof%nvar) :: & 589 571 & llvvalid 590 LOGICAL :: & 591 & lallpresent, & 592 & lnonepresent 572 LOGICAL :: lallpresent 573 LOGICAL :: lnonepresent 593 574 594 575 ! Check that either all or none of the masks are persent. … … 619 600 IF ( lvvalid(jvar)%luse(jj) ) & 620 601 & invpro(jvar) = invpro(jvar) +1 621 END DO622 END DO602 END DO 603 END DO 623 604 ENDIF 624 END DO605 END DO 625 606 ELSE 626 607 inprof = prof%nprof … … 643 624 DO jvar = 1, prof%nvar 644 625 ALLOCATE( llvvalid(jvar)%luse(prof%nvprot(jvar)) ) 645 END DO626 END DO 646 627 IF ( lallpresent ) THEN 647 628 llvalid%luse(:) = lvalid%luse(:) 648 629 DO jvar = 1, prof%nvar 649 630 llvvalid(jvar)%luse(:) = lvvalid(jvar)%luse(:) 650 END DO631 END DO 651 632 ELSE 652 633 llvalid%luse(:) = .TRUE. 653 634 DO jvar = 1, prof%nvar 654 635 llvvalid(jvar)%luse(:) = .TRUE. 655 END DO636 END DO 656 637 ENDIF 657 638 … … 807 788 !!---------------------------------------------------------------------- 808 789 !! * Arguments 809 TYPE(obs_prof),INTENT(INOUT) :: & 810 & prof ! Updated profile data 811 TYPE(obs_prof),INTENT(INOUT) :: & 812 & oldprof ! Original profile data 813 LOGICAL :: & 814 & ldeallocate ! Deallocate the updated data of insertion 815 INTEGER,INTENT(in) :: & 816 & kumout ! Output unit 790 TYPE(obs_prof),INTENT(INOUT) :: prof ! Updated profile data 791 TYPE(obs_prof),INTENT(INOUT) :: oldprof ! Original profile data 792 LOGICAL :: ldeallocate ! Deallocate the updated data of insertion 793 INTEGER,INTENT(in) :: kumout ! Output unit 817 794 818 795 !!* Local variables 819 INTEGER :: & 820 & jvar, & 821 & jext, & 822 & ji, & 823 & jj, & 824 & jk, & 825 & jl 796 INTEGER :: jvar 797 INTEGER :: jext 798 INTEGER :: ji 799 INTEGER :: jj 800 INTEGER :: jk 801 INTEGER :: jl 826 802 827 803 DO ji = 1, prof%nprof … … 878 854 oldprof%var(jvar)%vext(jl,jext) = & 879 855 & prof%var(jvar)%vext(jj,jext) 880 END DO856 END DO 881 857 882 END DO883 884 END DO858 END DO 859 860 END DO 885 861 886 END DO862 END DO 887 863 888 864 ! Optionally deallocate the updated profile data … … 906 882 !!---------------------------------------------------------------------- 907 883 !! * Arguments 908 TYPE(obs_prof),INTENT(INOUT) :: & 909 & prof ! Profile data 910 INTEGER,INTENT(IN) :: & 911 & kvarno ! Variable number 884 TYPE(obs_prof),INTENT(INOUT) :: prof ! Profile data 885 INTEGER,INTENT(IN) :: kvarno ! Variable number 912 886 913 887 !!* Local variables 914 INTEGER :: & 915 & ji, & 916 & iprofno 888 INTEGER :: ji 889 INTEGER :: iprofno 917 890 918 891 !----------------------------------------------------------------------- … … 928 901 prof%npvend(iprofno,kvarno) = & 929 902 & MAX( ji, prof%npvend(iprofno,kvarno) ) 930 END DO903 END DO 931 904 932 905 DO ji = 1, prof%nprof 933 906 IF ( prof%npvsta(ji,kvarno) == ( prof%nvprot(kvarno) + 1 ) ) & 934 907 & prof%npvsta(ji,kvarno) = 0 935 END DO908 END DO 936 909 937 910 END SUBROUTINE obs_prof_staend -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_read_altbias.F90
r2001 r2074 63 63 64 64 !! * Arguments 65 INTEGER, INTENT(IN) :: & 66 & kslano ! Number of SLA Products 65 INTEGER, INTENT(IN) :: kslano ! Number of SLA Products 67 66 TYPE(obs_surf), DIMENSION(kslano), INTENT(INOUT) :: & 68 67 & sladata ! SLA data 69 INTEGER, INTENT(IN) :: & 70 & k2dint 68 INTEGER, INTENT(IN) :: k2dint 71 69 CHARACTER(LEN=128) :: bias_file 72 70 73 71 !! * Local declarations 74 72 75 CHARACTER(LEN=12), PARAMETER :: & 76 & cpname = 'obs_rea_altbias' 77 78 INTEGER :: & 79 & jslano, & ! Data set loop variable 80 & jobs, & ! Obs loop variable 81 & jpialtbias, & ! Number of grid point in latitude for the bias 82 & jpjaltbias, & ! Number of grid point in longitude for the bias 83 & iico, & ! Grid point indicies 84 & ijco 85 INTEGER :: & 86 & i_nx_id, & ! Index to read the NetCDF file 87 & i_ny_id, & ! 88 & i_file_id, & ! 89 & i_var_id 73 CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_rea_altbias' 74 75 INTEGER :: jslano ! Data set loop variable 76 INTEGER :: jobs ! Obs loop variable 77 INTEGER :: jpialtbias ! Number of grid point in latitude for the bias 78 INTEGER :: jpjaltbias ! Number of grid point in longitude for the bias 79 INTEGER :: iico ! Grid point indicies 80 INTEGER :: ijco 81 INTEGER :: i_nx_id ! Index to read the NetCDF file 82 INTEGER :: i_ny_id ! 83 INTEGER :: i_file_id ! 84 INTEGER :: i_var_id 90 85 91 86 REAL(wp), DIMENSION(jpi,jpj) :: & … … 101 96 & zglam, & 102 97 & zgphi 103 REAL(wp) :: & 104 & zlam, & 105 & zphi 98 REAL(wp) :: zlam 99 REAL(wp) :: zphi 106 100 INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 107 101 & igrdi, & 108 102 & igrdj 109 INTEGER :: & 110 & numaltbias 103 INTEGER :: numaltbias 111 104 112 105 IF(lwp)WRITE(numout,*) -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_read_prof.F90
r2001 r2074 60 60 61 61 !! * Arguments 62 INTEGER :: & 63 & kformat ! Format of input data 64 ! ! 1: ENACT 65 ! ! 2: Coriolis 66 TYPE(obs_prof), INTENT(OUT) :: & 67 & profdata ! Profile data to be read 68 INTEGER, INTENT(IN) :: & 69 & knumfiles ! Number of files to read in 62 INTEGER :: kformat ! Format of input data 63 ! ! 1: ENACT 64 ! ! 2: Coriolis 65 TYPE(obs_prof), INTENT(OUT) :: profdata ! Profile data to be read 66 INTEGER, INTENT(IN) :: knumfiles ! Number of files to read in 70 67 CHARACTER(LEN=128), INTENT(IN) :: & 71 & cfilenames(knumfiles) ! File names to read in 72 INTEGER, INTENT(IN) :: & 73 & kvars, & ! Number of variables in profdata 74 & kextr, & ! Number of extra fields for each var in profdata 75 & kstp ! Ocean time-step index 76 LOGICAL, INTENT(IN) :: & 77 & ldt3d, & ! Observed variables switches 78 & lds3d, & 79 & ldignmis, & ! Ignore missing files 80 & ldsatt, & ! Compute salinity at all temperature points 81 & ldavtimset, & ! Correct time for daily averaged data 82 & ldmod ! Initialize model from input data 83 REAL(KIND=dp), INTENT(IN) :: & 84 & ddobsini, & ! Obs. ini time in YYYYMMDD.HHMMSS 85 & ddobsend ! Obs. end time in YYYYMMDD.HHMMSS 68 & cfilenames(knumfiles) ! File names to read in 69 INTEGER, INTENT(IN) :: kvars ! Number of variables in profdata 70 INTEGER, INTENT(IN) :: kextr ! Number of extra fields for each var in profdata 71 INTEGER, INTENT(IN) :: kstp ! Ocean time-step index 72 LOGICAL, INTENT(IN) :: ldt3d ! Observed variables switches 73 LOGICAL, INTENT(IN) :: lds3d 74 LOGICAL, INTENT(IN) :: ldignmis ! Ignore missing files 75 LOGICAL, INTENT(IN) :: ldsatt ! Compute salinity at all temperature points 76 LOGICAL, INTENT(IN) :: ldavtimset ! Correct time for daily averaged data 77 LOGICAL, INTENT(IN) :: ldmod ! Initialize model from input data 78 REAL(KIND=dp), INTENT(IN) :: ddobsini ! Obs. ini time in YYYYMMDD.HHMMSS 79 REAL(KIND=dp), INTENT(IN) :: ddobsend ! Obs. end time in YYYYMMDD.HHMMSS 86 80 INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 87 81 & kdailyavtypes … … 89 83 !! * Local declarations 90 84 CHARACTER(LEN=15), PARAMETER :: cpname='obs_rea_pro_dri' 91 INTEGER :: & 92 & jvar, & 93 & ji, & 94 & jj, & 95 & jk 96 INTEGER :: & 97 & ij, & 98 & iflag, & 99 & inobf, & 100 & i_file_id, & 101 & inowin, & 102 & iyea, & 103 & imon, & 104 & iday, & 105 & ihou, & 106 & imin, & 107 & isec 85 INTEGER :: jvar 86 INTEGER :: ji 87 INTEGER :: jj 88 INTEGER :: jk 89 INTEGER :: ij 90 INTEGER :: iflag 91 INTEGER :: inobf 92 INTEGER :: i_file_id 93 INTEGER :: inowin 94 INTEGER :: iyea 95 INTEGER :: imon 96 INTEGER :: iday 97 INTEGER :: ihou 98 INTEGER :: imin 99 INTEGER :: isec 108 100 INTEGER, DIMENSION(knumfiles) :: & 109 101 & irefdate … … 113 105 & ityps, & 114 106 & itypsmpp 115 INTEGER :: & 116 & it3dtmpp, & 117 & is3dtmpp, & 118 & ip3dtmpp 107 INTEGER :: it3dtmpp 108 INTEGER :: is3dtmpp 109 INTEGER :: ip3dtmpp 119 110 INTEGER, DIMENSION(:), ALLOCATABLE :: & 120 111 & iobsi, & … … 132 123 REAL(dp), DIMENSION(:), ALLOCATABLE :: & 133 124 & zdat 134 LOGICAL :: & 135 & llvalprof 125 LOGICAL :: llvalprof 136 126 TYPE(obfbdata), POINTER, DIMENSION(:) :: & 137 127 & inpfiles … … 139 129 & djulini, & 140 130 & djulend 141 INTEGER :: & 142 & iprof, & 143 & iproftot, & 144 & it3dt0, & 145 & is3dt0, & 146 & it3dt, & 147 & is3dt, & 148 & ip3dt 131 INTEGER :: iprof 132 INTEGER :: iproftot 133 INTEGER :: it3dt0 134 INTEGER :: is3dt0 135 INTEGER :: it3dt 136 INTEGER :: is3dt 137 INTEGER :: ip3dt 149 138 INTEGER, DIMENSION(kvars) :: & 150 139 & iv3dt 151 CHARACTER(len=8) :: & 152 & cl_refdate 140 CHARACTER(len=8) :: cl_refdate 153 141 154 142 ! Local initialization … … 232 220 CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), & 233 221 & ldgrid = .TRUE. ) 222 IF ( inpfiles(jj)%nvar < 2 ) THEN 223 CALL ctl_stop( 'Feedback format error' ) 224 RETURN 225 ENDIF 226 IF ( TRIM(inpfiles(jj)%cname(1)) /= 'POTM' ) THEN 227 CALL ctl_stop( 'Feedback format error' ) 228 RETURN 229 ENDIF 230 IF ( TRIM(inpfiles(jj)%cname(2)) /= 'PSAL' ) THEN 231 CALL ctl_stop( 'Feedback format error' ) 232 RETURN 233 ENDIF 234 234 IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN 235 235 CALL ctl_stop( 'Model not in input data' ) … … 295 295 inowin = 0 296 296 DO ji = 1, inpfiles(jj)%nobs 297 IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 298 IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 299 & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 297 300 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 298 301 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 307 310 inowin = 0 308 311 DO ji = 1, inpfiles(jj)%nobs 312 IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 313 IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 314 & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 309 315 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 310 316 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 319 325 inowin = 0 320 326 DO ji = 1, inpfiles(jj)%nobs 327 IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 328 IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 329 & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 321 330 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 322 331 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 330 339 331 340 DO ji = 1, inpfiles(jj)%nobs 341 IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 342 IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 343 & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 332 344 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 333 345 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 371 383 ENDIF 372 384 END DO loop_p_count 385 373 386 IF ( llvalprof ) iprof = iprof + 1 387 374 388 ENDIF 375 389 END DO … … 389 403 DO jj = 1, inobf 390 404 DO ji = 1, inpfiles(jj)%nobs 405 IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 406 IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 407 & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 391 408 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 392 409 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 401 418 DO jj = 1, inobf 402 419 DO ji = 1, inpfiles(jj)%nobs 420 IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 421 IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 422 & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 403 423 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 404 424 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 408 428 zdat(jk) = inpfiles(jj)%ptim(ji) 409 429 ENDIF 410 END DO411 END DO430 END DO 431 END DO 412 432 CALL sort_dp_indx( iproftot, & 413 433 & zdat, & … … 446 466 jj = ifileidx(iindx(jk)) 447 467 ji = iprofidx(iindx(jk)) 468 469 IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 470 IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 471 & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 472 448 473 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 449 474 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 456 481 457 482 llvalprof = .FALSE. 483 484 IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 485 486 IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 487 & ( inpfiles(jj)%ivqc(ji,2) > 2 ) ) CYCLE 458 488 459 489 loop_prof : DO ij = 1, inpfiles(jj)%nlev … … 711 741 & ityptmpp(ji+1) 712 742 ENDIF 713 END DO743 END DO 714 744 WRITE(numout,'(1X,A)') & 715 745 & '---------------------------------------------------------------' … … 728 758 & itypsmpp(ji+1) 729 759 ENDIF 730 END DO760 END DO 731 761 WRITE(numout,'(1X,A)') & 732 762 & '---------------------------------------------------------------' -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_read_seaice.F90
r2001 r2074 57 57 58 58 !! * Arguments 59 INTEGER :: & 60 & kformat ! Format of input data 61 ! ! 0: Feedback 62 ! ! 1: GHRSST 59 INTEGER :: kformat ! Format of input data 60 ! ! 0: Feedback 61 ! ! 1: GHRSST 63 62 TYPE(obs_surf), INTENT(INOUT) :: & 64 63 & seaicedata ! seaice data to be read 65 INTEGER, INTENT(IN) :: & 66 & knumfiles ! Number of corio format files to read in 67 CHARACTER(LEN=128), INTENT(IN) :: & 68 & cfilenames(knumfiles) ! File names to read in 69 INTEGER, INTENT(IN) :: & 70 & kvars, & ! Number of variables in seaicedata 71 & kextr, & ! Number of extra fields for each var in seaicedata 72 & kstp ! Ocean time-step index 73 LOGICAL, INTENT(IN) :: & 74 & ldignmis, & ! Ignore missing files 75 & ldmod ! Initialize model from input data 76 REAL(KIND=dp), INTENT(IN) :: & 77 & ddobsini, & ! Obs. ini time in YYYYMMDD.HHMMSS 78 & ddobsend ! Obs. end time in YYYYMMDD.HHMMSS 64 INTEGER, INTENT(IN) :: knumfiles ! Number of corio format files to read in 65 CHARACTER(LEN=128), INTENT(IN) :: cfilenames(knumfiles) ! File names to read in 66 INTEGER, INTENT(IN) :: kvars ! Number of variables in seaicedata 67 INTEGER, INTENT(IN) :: kextr ! Number of extra fields for each var in seaicedata 68 INTEGER, INTENT(IN) :: kstp ! Ocean time-step index 69 LOGICAL, INTENT(IN) :: ldignmis ! Ignore missing files 70 LOGICAL, INTENT(IN) :: ldmod ! Initialize model from input data 71 REAL(KIND=dp), INTENT(IN) :: ddobsini ! Obs. ini time in YYYYMMDD.HHMMSS 72 REAL(KIND=dp), INTENT(IN) :: ddobsend ! Obs. end time in YYYYMMDD.HHMMSS 79 73 80 74 !! * Local declarations 81 75 CHARACTER(LEN=14), PARAMETER :: cpname='obs_rea_seaice' 82 INTEGER :: & 83 & ji, & 84 & jj, & 85 & jk 86 INTEGER :: & 87 & iflag, & 88 & inobf, & 89 & i_file_id, & 90 & inowin, & 91 & iyea, & 92 & imon, & 93 & iday, & 94 & ihou, & 95 & imin, & 96 & isec 76 INTEGER :: ji 77 INTEGER :: jj 78 INTEGER :: jk 79 INTEGER :: iflag 80 INTEGER :: inobf 81 INTEGER :: i_file_id 82 INTEGER :: inowin 83 INTEGER :: iyea 84 INTEGER :: imon 85 INTEGER :: iday 86 INTEGER :: ihou 87 INTEGER :: imin 88 INTEGER :: isec 97 89 INTEGER, DIMENSION(knumfiles) :: & 98 90 & irefdate 99 INTEGER :: & 100 & iobsmpp 101 INTEGER, PARAMETER :: & 102 & iseaicemaxtype = 1024 91 INTEGER :: iobsmpp 92 INTEGER, PARAMETER :: iseaicemaxtype = 1024 103 93 INTEGER, DIMENSION(0:iseaicemaxtype) :: & 104 94 & ityp, & … … 117 107 REAL(dp), DIMENSION(:), ALLOCATABLE :: & 118 108 & zdat 119 LOGICAL :: & 120 & llvalprof 109 LOGICAL :: llvalprof 121 110 TYPE(obfbdata), POINTER, DIMENSION(:) :: & 122 111 & inpfiles … … 124 113 & djulini, & 125 114 & djulend 126 INTEGER :: & 127 & iobs, & 128 & iobstot 129 CHARACTER(len=8) :: & 130 & cl_refdate 115 INTEGER :: iobs 116 INTEGER :: iobstot 117 CHARACTER(len=8) :: cl_refdate 131 118 132 119 ! Local initialization … … 438 425 WRITE(numout,'(1X,A4,I4,A3,I10)')'Type ', jj,' = ',itypmpp(jj) 439 426 ENDIF 440 END DO427 END DO 441 428 WRITE(numout,'(1X,A50)')'--------------------------------------------------' 442 429 WRITE(numout,'(1X,A40,I10)')'Total = ',iobsmpp -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_read_sla.F90
r2001 r2074 37 37 & sladata, knumfiles, cfilenames, & 38 38 & kvars, kextr, kstp, ddobsini, ddobsend, & 39 & ldignmis, ldmod )39 & ldignmis, ldmod, ldobstd ) 40 40 !!--------------------------------------------------------------------- 41 41 !! … … 56 56 57 57 !! * Arguments 58 INTEGER :: & 59 & kformat ! Format of input data 60 ! ! 0: Feedback 61 ! ! 1: AVISO 62 TYPE(obs_surf), INTENT(INOUT) :: & 63 & sladata ! SLA data to be read 64 INTEGER, INTENT(IN) :: & 65 & knumfiles ! Number of files to read in 58 INTEGER :: kformat ! Format of input data 59 ! ! 0: Feedback 60 ! ! 1: AVISO 61 TYPE(obs_surf), INTENT(INOUT) :: sladata ! SLA data to be read 62 INTEGER, INTENT(IN) :: knumfiles ! Number of files to read in 66 63 CHARACTER(LEN=128), INTENT(IN) :: & 67 64 & cfilenames(knumfiles) ! File names to read in 68 INTEGER, INTENT(IN) :: & 69 & kvars, & ! Number of variables in sladata 70 & kextr, & ! Number of extra fields for each var in sladata 71 & kstp ! Ocean time-step index 72 LOGICAL, INTENT(IN) :: & 73 & ldignmis, & ! Ignore missing files 74 & ldmod ! Initialize model from input data 75 REAL(KIND=dp), INTENT(IN) :: & 76 & ddobsini, & ! Obs. ini time in YYYYMMDD.HHMMSS 77 & ddobsend ! Obs. end time in YYYYMMDD.HHMMSS 65 INTEGER, INTENT(IN) :: kvars ! Number of variables in sladata 66 INTEGER, INTENT(IN) :: kextr ! Number of extra fields for each var in sladata 67 INTEGER, INTENT(IN) :: kstp ! Ocean time-step index 68 LOGICAL, INTENT(IN) :: ldignmis ! Ignore missing files 69 LOGICAL, INTENT(IN) :: ldmod ! Initialize model from input data 70 LOGICAL, INTENT(INOUT), optional :: & 71 & ldobstd ! Read observation standard deviation from fb. file 72 REAL(KIND=dp), INTENT(IN) :: ddobsini ! Obs. ini time in YYYYMMDD.HHMMSS 73 REAL(KIND=dp), INTENT(IN) :: ddobsend ! Obs. end time in YYYYMMDD.HHMMSS 78 74 79 75 !! * Local declarations 80 76 CHARACTER(LEN=11), PARAMETER :: cpname='obs_rea_sla' 81 INTEGER :: & 82 & ji, & 83 & jj, & 84 & jk 85 INTEGER :: & 86 & iflag, & 87 & inobf, & 88 & i_file_id, & 89 & inowin, & 90 & iyea, & 91 & imon, & 92 & iday, & 93 & ihou, & 94 & imin, & 95 & isec 77 INTEGER :: ji 78 INTEGER :: jj 79 INTEGER :: jk 80 INTEGER :: iflag 81 INTEGER :: inobf 82 INTEGER :: i_file_id 83 INTEGER :: inowin 84 INTEGER :: iyea 85 INTEGER :: imon 86 INTEGER :: iday 87 INTEGER :: ihou 88 INTEGER :: imin 89 INTEGER :: isec 96 90 INTEGER, DIMENSION(knumfiles) :: & 97 91 & irefdate 98 INTEGER :: & 99 & iobsmpp 92 INTEGER :: iobsmpp 100 93 INTEGER, DIMENSION(imaxmissions+1) :: & 101 94 & ityp, & … … 108 101 & ifileidx, & 109 102 & islaidx 110 INTEGER :: itype 103 INTEGER :: itype 111 104 REAL(wp), DIMENSION(:), ALLOCATABLE :: & 112 105 & zphi, & … … 114 107 REAL(dp), DIMENSION(:), ALLOCATABLE :: & 115 108 & zdat 116 LOGICAL :: &117 & llvalprof109 LOGICAL :: llvalprof 110 LOGICAL :: llobstd 118 111 TYPE(obfbdata), POINTER, DIMENSION(:) :: & 119 112 & inpfiles … … 121 114 & djulini, & 122 115 & djulend 123 INTEGER :: & 124 & iobs, & 125 & iobstot 126 CHARACTER(len=8) :: & 127 & cl_refdate 116 INTEGER, DIMENSION(knumfiles) :: & 117 & iobspos, & 118 & iobcpos 119 INTEGER :: iobs 120 INTEGER :: iobstot 121 CHARACTER(len=8) :: cl_refdate 128 122 129 123 ! Local initialization 130 124 iobs = 0 125 IF ( PRESENT(ldobstd) ) THEN 126 IF (.NOT.ldmod) THEN 127 llobstd = .false. 128 ELSE 129 llobstd = ldobstd 130 ENDIF 131 ELSE 132 llobstd = .FALSE. 133 ENDIF 131 134 132 135 !----------------------------------------------------------------------- 133 ! Check datathe model part is just with feedback data files136 ! Check that the model part is just with feedback data files 134 137 !----------------------------------------------------------------------- 135 138 IF ( ldmod .AND. ( kformat /= 0 ) ) THEN 136 139 CALL ctl_stop( 'Model can only be read from feedback data' ) 140 RETURN 141 ENDIF 142 143 !----------------------------------------------------------------------- 144 ! Check that the prescribed obs err is just with feedback data files 145 !----------------------------------------------------------------------- 146 IF ( llobstd .AND. ( kformat /= 0 ) ) THEN 147 CALL ctl_stop( 'Observation error can only be read from feedback files' ) 137 148 RETURN 138 149 ENDIF … … 197 208 CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), & 198 209 & ldgrid = .TRUE. ) 210 IF ( inpfiles(jj)%nvar < 1 ) THEN 211 CALL ctl_stop( 'Feedback format error' ) 212 RETURN 213 ENDIF 214 IF ( TRIM(inpfiles(jj)%cname(1)) /= 'SLA' ) THEN 215 CALL ctl_stop( 'Feedback format error' ) 216 RETURN 217 ENDIF 199 218 IF ( ldmod .AND. ( ( inpfiles(jj)%nadd == 0 ) .OR.& 200 & ( inpfiles(jj)%next < 2) ) ) THEN219 & ( inpfiles(jj)%next == 0 ) ) ) THEN 201 220 CALL ctl_stop( 'Model not in input data' ) 202 221 RETURN … … 242 261 inowin = 0 243 262 DO ji = 1, inpfiles(jj)%nobs 263 IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 264 IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE 244 265 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 245 266 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 254 275 inowin = 0 255 276 DO ji = 1, inpfiles(jj)%nobs 277 IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 278 IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE 256 279 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 257 280 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 266 289 inowin = 0 267 290 DO ji = 1, inpfiles(jj)%nobs 291 IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 292 IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE 268 293 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 269 294 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 277 302 278 303 DO ji = 1, inpfiles(jj)%nobs 304 IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 305 IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE 279 306 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 280 307 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 293 320 294 321 ENDIF 295 322 296 323 END DO sla_files 297 324 325 IF (llobstd) THEN 326 327 DO jj = 1, inobf 328 iobspos(jj) = -1 329 iobcpos(jj) = -1 330 DO ji = 1,inpfiles(jj)%nadd 331 IF ( TRIM(inpfiles(jj)%caddname(ji)) == 'OSTD' ) THEN 332 iobspos(jj)=ji 333 ENDIF 334 IF ( TRIM(inpfiles(jj)%caddname(ji)) == 'OCNT' ) THEN 335 iobcpos(jj)=ji 336 ENDIF 337 END DO 338 END DO 339 llobstd = ( ( MINVAL(iobspos) > 0 ) .AND. ( MINVAL(iobcpos) > 0 ) ) 340 IF (llobstd) THEN 341 IF (lwp) WRITE(numout,*)'SLA superobs information present.' 342 ELSE 343 IF (lwp) WRITE(numout,*)'SLA superobs information not present.' 344 ENDIF 345 346 ENDIF 347 298 348 !----------------------------------------------------------------------- 299 349 ! Get the time ordered indices of the input data … … 306 356 DO jj = 1, inobf 307 357 DO ji = 1, inpfiles(jj)%nobs 358 IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 359 IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE 308 360 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 309 361 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 318 370 DO jj = 1, inobf 319 371 DO ji = 1, inpfiles(jj)%nobs 372 IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 373 IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE 320 374 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 321 375 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 344 398 jj = ifileidx(iindx(jk)) 345 399 ji = islaidx(iindx(jk)) 400 401 IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 402 IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE 403 346 404 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 347 405 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 390 448 ityp(itype+1) = ityp(itype+1) + 1 391 449 450 ! Identifier 451 sladata%cwmo(iobs) = inpfiles(jj)%cdwmo(ji) 452 392 453 ! Bookkeeping data to match observations 393 454 sladata%nsidx(iobs) = iobs … … 404 465 IF ( ldmod ) THEN 405 466 sladata%rmod(iobs,1) = inpfiles(jj)%padd(1,ji,1,1) 406 sladata%rext(iobs,1:2) = inpfiles(jj)%pext(1,ji,1:2) 467 sladata%rext(iobs,1) = inpfiles(jj)%padd(1,ji,2,1) 468 sladata%rext(iobs,2) = inpfiles(jj)%pext(1,ji,1) 469 IF (llobstd) THEN 470 sladata%rext(iobs,3) = & 471 & inpfiles(jj)%padd(1,ji,iobspos(jj),1) 472 sladata%rext(iobs,4) = & 473 & inpfiles(jj)%padd(1,ji,iobcpos(jj),1) 474 ENDIF 407 475 ELSE 408 476 sladata%rmod(iobs,1) = fbrmdi 409 477 sladata%rext(iobs,:) = fbrmdi 410 478 ENDIF 479 411 480 ENDIF 412 481 ENDIF … … 433 502 WRITE(numout,'(1X,A38,A2,I10)')calttyp(jj-1),'= ',itypmpp(jj) 434 503 ENDIF 435 END DO504 END DO 436 505 WRITE(numout,'(1X,A50)')'--------------------------------------------------' 437 506 WRITE(numout,'(1X,A40,I10)')'Total = ',iobsmpp … … 453 522 DEALLOCATE( inpfiles ) 454 523 524 !----------------------------------------------------------------------- 525 ! Reset ldobstd if the data is present 526 !----------------------------------------------------------------------- 527 IF ( PRESENT(ldobstd) ) THEN 528 ldobstd = llobstd 529 ENDIF 530 455 531 END SUBROUTINE obs_rea_sla 456 532 -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_read_sst.F90
r2001 r2074 58 58 59 59 !! * Arguments 60 INTEGER :: & 61 & kformat ! Format of input data 62 ! ! 0: Feedback 63 ! ! 1: GHRSST 64 TYPE(obs_surf), INTENT(INOUT) :: & 65 & sstdata ! SST data to be read 66 INTEGER, INTENT(IN) :: & 67 & knumfiles ! Number of corio format files to read in 68 CHARACTER(LEN=128), INTENT(IN) :: & 69 & cfilenames(knumfiles) ! File names to read in 70 INTEGER, INTENT(IN) :: & 71 & kvars, & ! Number of variables in sstdata 72 & kextr, & ! Number of extra fields for each var in sstdata 73 & kstp ! Ocean time-step index 74 LOGICAL, INTENT(IN) :: & 75 & ldignmis, & ! Ignore missing files 76 & ldmod ! Initialize model from input data 77 REAL(KIND=dp), INTENT(IN) :: & 78 & ddobsini, & ! Obs. ini time in YYYYMMDD.HHMMSS 79 & ddobsend ! Obs. end time in YYYYMMDD.HHMMSS 60 INTEGER :: kformat ! Format of input data 61 ! ! 0: Feedback 62 ! ! 1: GHRSST 63 TYPE(obs_surf), INTENT(INOUT) :: sstdata ! SST data to be read 64 INTEGER, INTENT(IN) :: knumfiles ! Number of corio format files to read in 65 CHARACTER(LEN=128), INTENT(IN) :: cfilenames(knumfiles) ! File names to read in 66 INTEGER, INTENT(IN) :: kvars ! Number of variables in sstdata 67 INTEGER, INTENT(IN) :: kextr ! Number of extra fields for each var in sstdata 68 INTEGER, INTENT(IN) :: kstp ! Ocean time-step index 69 LOGICAL, INTENT(IN) :: ldignmis ! Ignore missing files 70 LOGICAL, INTENT(IN) :: ldmod ! Initialize model from input data 71 REAL(KIND=dp), INTENT(IN) :: ddobsini ! Obs. ini time in YYYYMMDD.HHMMSS 72 REAL(KIND=dp), INTENT(IN) :: ddobsend ! Obs. end time in YYYYMMDD.HHMMSS 80 73 81 74 !! * Local declarations 82 75 CHARACTER(LEN=11), PARAMETER :: cpname='obs_rea_sst' 83 INTEGER :: & 84 & ji, & 85 & jj, & 86 & jk 87 INTEGER :: & 88 & iflag, & 89 & inobf, & 90 & i_file_id, & 91 & inowin, & 92 & iyea, & 93 & imon, & 94 & iday, & 95 & ihou, & 96 & imin, & 97 & isec 98 INTEGER, DIMENSION(knumfiles) :: & 99 & irefdate 100 INTEGER :: & 101 & iobsmpp 102 INTEGER, PARAMETER :: & 103 & isstmaxtype = 1024 76 INTEGER :: ji 77 INTEGER :: jj 78 INTEGER :: jk 79 INTEGER :: iflag 80 INTEGER :: inobf 81 INTEGER :: i_file_id 82 INTEGER :: inowin 83 INTEGER :: iyea 84 INTEGER :: imon 85 INTEGER :: iday 86 INTEGER :: ihou 87 INTEGER :: imin 88 INTEGER :: isec 89 INTEGER, DIMENSION(knumfiles) :: irefdate 90 INTEGER :: iobsmpp 91 INTEGER, PARAMETER :: isstmaxtype = 1024 104 92 INTEGER, DIMENSION(0:isstmaxtype) :: & 105 93 & ityp, & … … 118 106 REAL(dp), DIMENSION(:), ALLOCATABLE :: & 119 107 & zdat 120 LOGICAL :: & 121 & llvalprof 108 LOGICAL :: llvalprof 122 109 TYPE(obfbdata), POINTER, DIMENSION(:) :: & 123 110 & inpfiles … … 125 112 & djulini, & 126 113 & djulend 127 INTEGER :: & 128 & iobs, & 129 & iobstot 130 CHARACTER(len=8) :: & 131 & cl_refdate 114 INTEGER :: iobs 115 INTEGER :: iobstot 116 CHARACTER(len=8) :: cl_refdate 132 117 133 118 ! Local initialization … … 439 424 WRITE(numout,'(1X,A4,I4,A3,I10)')'Type ', jj,' = ',itypmpp(jj) 440 425 ENDIF 441 END DO426 END DO 442 427 WRITE(numout,'(1X,A50)')'--------------------------------------------------' 443 428 WRITE(numout,'(1X,A40,I10)')'Total = ',iobsmpp … … 484 469 485 470 !! * Arguments 486 CHARACTER(len=128), INTENT(IN) :: & 487 & sstname ! Generic file name 488 CHARACTER(len=12), INTENT(IN) :: & 489 & cdsstfmt ! Format of SST files (yearly/monthly) 490 TYPE(obs_surf), INTENT(INOUT) :: & 491 & sstdata ! SST data 492 REAL(KIND=dp), INTENT(IN) :: & 493 & ddobsini, & ! Obs. ini time in YYYYMMDD.HHMMSS 494 & ddobsend ! Obs. end time in YYYYMMDD.HHMMSS 495 INTEGER, INTENT(IN) :: & 496 & kvars, & ! Number of variables in sstdata structures 497 & kextra, & ! Number of extra variables in sstdata structures 498 & kstp ! Ocean time-step index 499 500 INTEGER :: & 501 & iyear, & 502 & imon, & 503 & iday, & 504 & ihour, & 505 & imin, & 506 & isec, & 507 & ihhmmss, & 508 & iyear1, & 509 & iyear2, & 510 & imon1, & 511 & imon2, & 512 & iyearf, & 513 & imonf 514 REAL(KIND=wp) :: & 515 & pjulini, & 516 & pjulend, & 517 & pjulb, & 518 & pjule, & 519 & pjul 520 INTEGER :: & 521 & inumsst, & 522 & itotrec, & 523 & inumobs, & 524 & irec, & 525 & ifld, & 526 & inum 527 INTEGER :: & 528 & ji, jj 529 CHARACTER(len=128) :: & 530 & clname 531 CHARACTER(len=4) :: & 532 & cdyear 533 CHARACTER(len=2) :: & 534 & cdmon 535 REAL(kind=wp), ALLOCATABLE, DIMENSION(:,:,:) :: & 536 & zsstin 471 CHARACTER(len=128), INTENT(IN) :: sstname ! Generic file name 472 CHARACTER(len=12), INTENT(IN) :: cdsstfmt ! Format of SST files (yearly/monthly) 473 TYPE(obs_surf), INTENT(INOUT) :: sstdata ! SST data 474 REAL(KIND=dp), INTENT(IN) :: ddobsini ! Obs. ini time in YYYYMMDD.HHMMSS 475 REAL(KIND=dp), INTENT(IN) :: ddobsend ! Obs. end time in YYYYMMDD.HHMMSS 476 INTEGER, INTENT(IN) :: kvars ! Number of variables in sstdata structures 477 INTEGER, INTENT(IN) :: kextra ! Number of extra variables in sstdata structures 478 INTEGER, INTENT(IN) :: kstp ! Ocean time-step index 479 480 INTEGER :: iyear 481 INTEGER :: imon 482 INTEGER :: iday 483 INTEGER :: ihour 484 INTEGER :: imin 485 INTEGER :: isec 486 INTEGER :: ihhmmss 487 INTEGER :: iyear1 488 INTEGER :: iyear2 489 INTEGER :: imon1 490 INTEGER :: imon2 491 INTEGER :: iyearf 492 INTEGER :: imonf 493 REAL(KIND=wp) :: pjulini 494 REAL(KIND=wp) :: pjulend 495 REAL(KIND=wp) :: pjulb 496 REAL(KIND=wp) :: pjule 497 REAL(KIND=wp) :: pjul 498 INTEGER :: inumsst 499 INTEGER :: itotrec 500 INTEGER :: inumobs 501 INTEGER :: irec 502 INTEGER :: ifld 503 INTEGER :: inum 504 INTEGER :: ji, jj 505 CHARACTER(len=128) :: clname 506 CHARACTER(len=4) :: cdyear 507 CHARACTER(len=2) :: cdmon 508 REAL(kind=wp), ALLOCATABLE, DIMENSION(:,:,:) :: zsstin 537 509 538 510 IF (lwp) WRITE(numout,*)'In obs_rea_sst_rey',sstname … … 588 560 CALL iom_close ( inumsst ) 589 561 590 END 562 ENDIF 591 563 592 564 clname = sstname … … 646 618 CALL iom_close ( inumsst ) 647 619 648 END 620 ENDIF 649 621 650 622 clname = sstname … … 717 689 DO ji = nldi, nlei 718 690 IF ( tmask(ji,jj,1) == 1.0_wp ) inumobs = inumobs + 1 719 END DO720 END DO691 END DO 692 END DO 721 693 inumobs = inumobs * itotrec 722 694 … … 771 743 ENDIF 772 744 773 END DO774 END DO745 END DO 746 END DO 775 747 776 748 pjul = pjul + 1 … … 778 750 IF ( pjul > pjulend ) EXIT 779 751 780 END DO752 END DO 781 753 782 754 END SUBROUTINE obs_rea_sst_rey -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_read_vel.F90
r2001 r2074 59 59 60 60 !! * Arguments 61 INTEGER :: & 62 & kformat ! Format of input data 63 ! ! 1: ENACT 64 ! ! 2: Coriolis 65 TYPE(obs_prof), INTENT(OUT) :: & 66 & profdata ! Profile data to be read 67 INTEGER, INTENT(IN) :: & 68 & knumfiles ! Number of files to read in 69 CHARACTER(LEN=128), INTENT(IN) :: & 70 & cfilenames(knumfiles) ! File names to read in 71 INTEGER, INTENT(IN) :: & 72 & kvars, & ! Number of variables in profdata 73 & kextr, & ! Number of extra fields for each var in profdata 74 & kstp ! Ocean time-step index 75 LOGICAL, INTENT(IN) :: & 76 & ldignmis, & ! Ignore missing files 77 & ldavtimset, & ! Set time to be equal to the end of the day 78 & ldmod ! Initialize model from input data 79 REAL(KIND=dp), INTENT(IN) :: & 80 & ddobsini, & ! Obs. ini time in YYYYMMDD.HHMMSS 81 & ddobsend ! Obs. end time in YYYYMMDD.HHMMSS 61 INTEGER :: kformat ! Format of input data 62 ! ! 1: ENACT 63 ! ! 2: Coriolis 64 TYPE(obs_prof), INTENT(OUT) :: profdata ! Profile data to be read 65 INTEGER, INTENT(IN) :: knumfiles ! Number of files to read in 66 CHARACTER(LEN=128), INTENT(IN) :: cfilenames(knumfiles) ! File names to read in 67 INTEGER, INTENT(IN) :: kvars ! Number of variables in profdata 68 INTEGER, INTENT(IN) :: kextr ! Number of extra fields for each var in profdata 69 INTEGER, INTENT(IN) :: kstp ! Ocean time-step index 70 LOGICAL, INTENT(IN) :: ldignmis ! Ignore missing files 71 LOGICAL, INTENT(IN) :: ldavtimset ! Set time to be equal to the end of the day 72 LOGICAL, INTENT(IN) :: ldmod ! Initialize model from input data 73 REAL(KIND=dp), INTENT(IN) :: ddobsini ! Obs. ini time in YYYYMMDD.HHMMSS 74 REAL(KIND=dp), INTENT(IN) :: ddobsend ! Obs. end time in YYYYMMDD.HHMMSS 82 75 83 76 !! * Local declarations 84 77 CHARACTER(LEN=15), PARAMETER :: cpname='obs_rea_vel_dri' 85 INTEGER :: & 86 & jvar, & 87 & ji, & 88 & jj, & 89 & jk 90 INTEGER :: & 91 & ij, & 92 & iflag, & 93 & inobf, & 94 & i_file_id, & 95 & inowin, & 96 & iyea, & 97 & imon, & 98 & iday, & 99 & ihou, & 100 & imin, & 101 & isec 78 INTEGER :: jvar 79 INTEGER :: ji 80 INTEGER :: jj 81 INTEGER :: jk 82 INTEGER :: ij 83 INTEGER :: iflag 84 INTEGER :: inobf 85 INTEGER :: i_file_id 86 INTEGER :: inowin 87 INTEGER :: iyea 88 INTEGER :: imon 89 INTEGER :: iday 90 INTEGER :: ihou 91 INTEGER :: imin 92 INTEGER :: isec 102 93 INTEGER, DIMENSION(knumfiles) :: & 103 94 & irefdate … … 105 96 & itypuv, & 106 97 & itypuvmpp 107 INTEGER :: & 108 & iuv3dtmpp 98 INTEGER :: iuv3dtmpp 109 99 INTEGER, DIMENSION(:), ALLOCATABLE :: & 110 100 & iobsiu, & … … 130 120 & djulini, & 131 121 & djulend 132 INTEGER :: & 133 & iprof, & 134 & iproftot, & 135 & iuv3dt 136 INTEGER, DIMENSION(kvars) :: & 137 & iv3dt 138 CHARACTER(len=8) :: & 139 & cl_refdate 122 INTEGER :: iprof 123 INTEGER :: iproftot 124 INTEGER :: iuv3dt 125 INTEGER, DIMENSION(kvars) :: iv3dt 126 CHARACTER(len=8) :: cl_refdate 140 127 141 128 ! Local initialization … … 375 362 zdat(jk) = inpfiles(jj)%ptim(ji) 376 363 ENDIF 377 END DO378 END DO364 END DO 365 END DO 379 366 CALL sort_dp_indx( iproftot, & 380 367 & zdat, & … … 603 590 & itypuvmpp(ji+1) 604 591 ENDIF 605 END DO592 END DO 606 593 WRITE(numout,'(1X,A)') '--------------' 607 594 WRITE(numout,'(1X,A6,I8)') & -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_readmdt.F90
r2001 r2074 47 47 PRIVATE 48 48 49 INTEGER, PUBLIC :: & 50 & nmsshc = 1 ! MDT correction scheme 51 REAL(wp), PUBLIC :: & 52 & mdtcorr = 1.61 ! User specified MDT correction 53 REAL(wp), PUBLIC :: & 54 & mdtcutoff = 65.0 ! MDT cutoff for computed correction 49 INTEGER, PUBLIC :: nmsshc = 1 ! MDT correction scheme 50 REAL(wp), PUBLIC :: mdtcorr = 1.61 ! User specified MDT correction 51 REAL(wp), PUBLIC :: mdtcutoff = 65.0 ! MDT cutoff for computed correction 55 52 PUBLIC obs_rea_mdt ! Read the MDT 56 53 PUBLIC obs_offset_mdt ! Remove the offset between the model MDT and the … … 80 77 81 78 !! * Arguments 82 INTEGER, INTENT(IN) :: & 83 & kslano ! Number of SLA Products 79 INTEGER, INTENT(IN) :: kslano ! Number of SLA Products 84 80 TYPE(obs_surf), DIMENSION(kslano), INTENT(INOUT) :: & 85 81 & sladata ! SLA data 86 INTEGER, INTENT(IN) :: & 87 & k2dint 82 INTEGER, INTENT(IN) :: k2dint 88 83 89 84 !! * Local declarations … … 94 89 & mdtname = 'slaReferenceLevel.nc' 95 90 96 INTEGER :: & 97 & jslano, & ! Data set loop variable 98 & jobs, & ! Obs loop variable 99 & jpimdt, & ! Number of grid point in latitude for the MDT 100 & jpjmdt, & ! Number of grid point in longitude for the MDT 101 & iico, & ! Grid point indicies 102 & ijco 103 INTEGER :: & 104 & i_nx_id, & ! Index to read the NetCDF file 105 & i_ny_id, & ! 106 & i_file_id, & ! 107 & i_var_id, & 108 & i_stat 91 INTEGER :: jslano ! Data set loop variable 92 INTEGER :: jobs ! Obs loop variable 93 INTEGER :: jpimdt ! Number of grid point in latitude for the MDT 94 INTEGER :: jpjmdt ! Number of grid point in longitude for the MDT 95 INTEGER :: iico ! Grid point indicies 96 INTEGER :: ijco 97 INTEGER :: i_nx_id ! Index to read the NetCDF file 98 INTEGER :: i_ny_id ! 99 INTEGER :: i_file_id ! 100 INTEGER :: i_var_id 101 INTEGER :: i_stat 109 102 110 103 REAL(wp), DIMENSION(jpi,jpj) :: & 111 & z_mdt ! Array to store the MDT values 104 & z_mdt, & ! Array to store the MDT values 105 & mdtmask ! Array to store the mask for the MDT 112 106 REAL(wp), DIMENSION(1) :: & 113 107 & zext, & … … 120 114 & zglam, & 121 115 & zgphi 122 REAL(wp) :: &123 & zlam, &124 & zphi, &125 &zfill116 117 REAL(wp) :: zlam 118 REAL(wp) :: zphi 119 REAL(wp) :: zfill 126 120 REAL(sp) :: zinfill 127 121 INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 128 122 & igrdi, & 129 123 & igrdj 130 INTEGER :: & 131 & nummdt 124 INTEGER :: nummdt 132 125 133 126 IF(lwp)WRITE(numout,*) … … 156 149 zfill = zinfill 157 150 i_stat = nf90_close( nummdt ) 151 152 ! setup mask based on tmask and MDT mask 153 ! set mask to 0 where the MDT is set to fillvalue 154 155 WHERE(z_mdt(:,:) /= zfill) 156 mdtmask(:,:)=tmask(:,:,1) 157 ELSEWHERE 158 mdtmask(:,:)=0 159 END WHERE 158 160 159 161 ! Remove the offset between the MDT used with the sla and the model MDT … … 192 194 & igrdi, igrdj, gphit, zgphi ) 193 195 CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, & 194 & igrdi, igrdj, tmask(:,:,1), zmask )196 & igrdi, igrdj, mdtmask, zmask ) 195 197 CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, & 196 198 & igrdi, igrdj, z_mdt, zmdtl ) … … 200 202 zlam = sladata(jslano)%rlam(jobs) 201 203 zphi = sladata(jslano)%rphi(jobs) 202 iico = sladata(jslano)%mi(jobs) 203 ijco = sladata(jslano)%mj(jobs) 204 204 205 205 CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi, & 206 206 & zglam(:,:,jobs), zgphi(:,:,jobs), & 207 207 & zmask(:,:,jobs), zweig, zobsmask ) 208 208 209 210 IF ( z_mdt(iico-1,ijco-1) == zfill .OR. & 211 z_mdt(iico-1,ijco ) == zfill .OR. & 212 z_mdt(iico ,ijco-1) == zfill .OR. & 213 z_mdt(iico ,ijco ) == zfill ) THEN 214 215 sladata(jslano)%rext(jobs,2) = obfillflt 216 sladata(jslano)%nqc(jobs) = 11 ! set qc flag for data with no mdt 217 ELSE 218 219 CALL obs_int_h2d( 1, 1, & 209 CALL obs_int_h2d( 1, 1, & 220 210 & zweig, zmdtl(:,:,jobs), zext ) 221 222 sladata(jslano)%rext(jobs,2) = zext(1) 223 224 ENDIF 211 212 sladata(jslano)%rext(jobs,2) = zext(1) 213 214 ! mark any masked data with a QC flag 215 IF ( zobsmask(1) == 0 ) sladata(jslano)%nqc(jobs) = 11 225 216 226 217 END DO … … 265 256 REAL(wp), INTENT(IN) :: zfill 266 257 267 !! * Local declarations 268 REAL(wp) :: & 269 & zdxdy, & 270 & zarea, & 271 & zeta1, & 272 & zeta2, & 273 & zcorr_mdt, & 274 & zcorr_bcketa,& 275 & zcorr 276 REAL(wp), DIMENSION(jpi,jpj) :: & 277 & zpromsk 278 INTEGER :: & 279 & jj, & 280 & ji 258 !! * Local declarations 259 REAL(wp) :: zdxdy 260 REAL(wp) :: zarea 261 REAL(wp) :: zeta1 262 REAL(wp) :: zeta2 263 REAL(wp) :: zcorr_mdt 264 REAL(wp) :: zcorr_bcketa 265 REAL(wp) :: zcorr 266 REAL(wp), DIMENSION(jpi,jpj) :: zpromsk 267 INTEGER :: jj 268 INTEGER :: ji 281 269 CHARACTER(LEN=14), PARAMETER :: & 282 270 & cpname = 'obs_offset_mdt' -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_rot_vel.F90
r2001 r2074 51 51 52 52 !! * Arguments 53 TYPE(obs_prof), INTENT(INOUT) :: & 54 & profdata ! Profile data to be read 55 INTEGER, INTENT(IN) :: & 56 & k2dint ! Horizontal interpolation methed 53 TYPE(obs_prof), INTENT(INOUT) :: profdata ! Profile data to be read 54 INTEGER, INTENT(IN) :: k2dint ! Horizontal interpolation methed 57 55 REAL(wp), DIMENSION(*) :: & 58 56 & pu, & … … 64 62 & zsingv, & 65 63 & zcosgv 66 REAL(wp), DIMENSION(2,2,1) :: & 67 & zweig 64 REAL(wp), DIMENSION(2,2,1) :: zweig 68 65 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 69 66 & zmasku, & … … 82 79 & zsinv, & 83 80 & zcosv 84 REAL(wp) :: & 85 & zsin, & 86 & zcos 87 REAL(wp), DIMENSION(1) :: & 88 & zobsmask 81 REAL(wp) :: zsin 82 REAL(wp) :: zcos 83 REAL(wp), DIMENSION(1) :: zobsmask 89 84 INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 90 85 & igrdiu, & … … 92 87 & igrdiv, & 93 88 & igrdjv 94 INTEGER :: & 95 & ji, & 96 & jk 89 INTEGER :: ji 90 INTEGER :: jk 97 91 98 92 !----------------------------------------------------------------------- -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_seaice_io.h90
r2001 r2074 23 23 !! * Local declarations 24 24 CHARACTER(LEN=12),PARAMETER :: cpname = 'read_seaice' 25 INTEGER :: & 26 & i_file_id, & ! netcdf IDS 27 & i_time_id, & 28 & i_ni_id, & 29 & i_data_id, & 30 & i_var_id 31 INTEGER :: & 32 & i_data, & ! Number of data per parameter in current file 33 & i_time ! Number of reference times in file 25 INTEGER :: i_file_id ! netcdf IDS 26 INTEGER :: i_time_id 27 INTEGER :: i_ni_id 28 INTEGER :: i_data_id 29 INTEGER :: i_var_id 30 INTEGER :: i_data ! Number of data per parameter in current file 31 INTEGER :: i_time ! Number of reference times in file 34 32 INTEGER, DIMENSION(:), POINTER :: & 35 33 & i_reftime ! Reference time in file in seconds since 1/1/1981. … … 43 41 REAL(wp), DIMENSION(:,:), POINTER :: & 44 42 & z_seaice ! Seaice data 45 INTEGER, PARAMETER :: & 46 & imaxdim = 2 ! Assumed maximum for no. dims. in file 47 INTEGER, DIMENSION(2) :: & 48 & idims ! Dimensions in file 49 INTEGER :: & 50 & iilen, & ! Length of netCDF attributes 51 & itype ! Typeof netCDF attributes 52 REAL(KIND=wp) :: & 53 & zsca, & ! Scale factor 54 & zoff, & ! Offset for data in netcdf file 55 & z_offset, & ! Offset for time conversion 56 & zfill ! Fill value in netcdf file 57 CHARACTER (len=33) :: & 58 & creftime ! Reference time of file 59 INTEGER :: & 60 & i_refyear, & ! Integer version of reference time 61 & i_refmonth, & 62 & i_refday, & 63 & i_refhour, & 64 & i_refmin, & 65 & i_refsec 66 INTEGER :: & 67 & ichunk 68 integer :: & 69 & jtim, & 70 & jobs, & 71 & iobs 43 INTEGER, PARAMETER :: imaxdim = 2 ! Assumed maximum for no. dims. in file 44 INTEGER, DIMENSION(2) :: idims ! Dimensions in file 45 INTEGER :: iilen ! Length of netCDF attributes 46 INTEGER :: itype ! Typeof netCDF attributes 47 REAL(KIND=wp) :: zsca ! Scale factor 48 REAL(KIND=wp) :: zoff ! Offset for data in netcdf file 49 REAL(KIND=wp) :: z_offset ! Offset for time conversion 50 REAL(KIND=wp) :: zfill ! Fill value in netcdf file 51 CHARACTER (len=33) ::creftime ! Reference time of file 52 INTEGER :: i_refyear ! Integer version of reference time 53 INTEGER :: i_refmonth 54 INTEGER :: i_refday 55 INTEGER :: i_refhour 56 INTEGER :: i_refmin 57 INTEGER :: i_refsec 58 INTEGER :: ichunk 59 INTEGER :: jtim 60 INTEGER :: jobs 61 INTEGER :: iobs 72 62 73 63 CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, & -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_sla_io.h90
r2001 r2074 23 23 !! * Local declarations 24 24 CHARACTER(LEN=14),PARAMETER :: cpname = 'read_avisofile' 25 INTEGER :: & 26 & i_file_id, & ! netcdf IDS 27 & i_tracks_id, & 28 & i_cycles_id, & 29 & i_data_id, & 30 & i_var_id 31 INTEGER, PARAMETER :: & 32 & imaxdim = 2 ! Assumed maximum for no. dims. in file 33 INTEGER, DIMENSION(2) :: & 34 & idims ! Dimensions in file 35 INTEGER :: & 36 & iilen, & ! Length of netCDF attributes 37 & itype ! Typeof netCDF attributes 38 REAL(fbdp) :: & 39 & zsca, & ! Scale factor 40 & zfill ! Fill value 41 CHARACTER(len=3) :: & 42 & cmission ! Mission global attribute 43 INTEGER :: & 44 & itracks, & ! Maximum number of passes in file 45 & icycles, & ! Maximum number of cycles for each pass 46 & idata ! Number of data per parameter in current file 47 REAL(fbdp) :: & 48 & zdeltat ! Time gap getween two measurements in seconds 25 INTEGER :: i_file_id ! netcdf IDS 26 INTEGER :: i_tracks_id 27 INTEGER :: i_cycles_id 28 INTEGER :: i_data_id 29 INTEGER :: i_var_id 30 INTEGER, PARAMETER :: imaxdim = 2 ! Assumed maximum for no. dims. in file 31 INTEGER, DIMENSION(2) :: idims ! Dimensions in file 32 INTEGER :: iilen ! Length of netCDF attributes 33 INTEGER :: itype ! Typeof netCDF attributes 34 REAL(fbdp) :: zsca ! Scale factor 35 REAL(fbdp) :: zfill ! Fill value 36 CHARACTER(len=3) :: cmission ! Mission global attribute 37 INTEGER :: itracks ! Maximum number of passes in file 38 INTEGER :: icycles ! Maximum number of cycles for each pass 39 INTEGER :: idata ! Number of data per parameter in current file 40 REAL(fbdp) :: zdeltat ! Time gap getween two measurements in seconds 49 41 INTEGER, DIMENSION(:), POINTER :: & 50 42 & iptracks, & ! List of passes contained in current file … … 58 50 REAL(fbdp), DIMENSION(:,:), POINTER :: & 59 51 & zbegindates ! Date of point with index 0 52 REAL(fbdp) :: zbeginmiss ! Missing data for dates 60 53 REAL(fbsp), DIMENSION(:,:), POINTER :: & 61 54 & zsla ! SLA data 62 55 REAL(fbdp), DIMENSION(:), POINTER :: & 63 56 & zjuld ! Julian date 64 CHARACTER(len=14):: &65 & cdjuldref ! Julian data reference66 INTEGER :: &67 & imission! Mission number converted from Mission global57 LOGICAL, DIMENSION(:), POINTER :: & 58 & llskip ! Skip observation 59 CHARACTER(len=14) :: cdjuldref ! Julian data reference 60 INTEGER :: imission ! Mission number converted from Mission global 68 61 ! netCDF atttribute. 69 CHARACTER(len=255) :: & 70 & ctmp 71 INTEGER :: & 72 & iobs 73 INTEGER :: & 74 & jl, & 75 & jm, & 76 & jj, & 77 & ji, & 78 & jk, & 79 & jobs, & 80 & jcycle 62 CHARACTER(len=255) :: ctmp 63 INTEGER :: iobs 64 INTEGER :: jl 65 INTEGER :: jm 66 INTEGER :: jj 67 INTEGER :: ji 68 INTEGER :: jk 69 INTEGER :: jobs 70 INTEGER :: jcycle 81 71 82 72 ! Open the file … … 116 106 & ipdataindexes( idata ), & 117 107 & zsla ( icycles, idata ), & 118 & zjuld ( idata*icycles ) & 108 & zjuld ( idata*icycles ), & 109 & llskip ( idata*icycles ) & 119 110 & ) 120 111 … … 218 209 ENDIF 219 210 IF (jl>14) EXIT 220 ENDDO 211 END DO 212 CALL chkerr( nf90_inquire_attribute( i_file_id, i_var_id, '_FillValue', & 213 & xtype = itype), cpname, __LINE__ ) 214 IF ( itype /= NF90_DOUBLE ) THEN 215 CALL fatal_error('Error decoding BeginDates missing data', __LINE__ ) 216 ENDIF 217 CALL chkerr( nf90_get_att( i_file_id, i_var_id, '_FillValue', & 218 & zbeginmiss ), cpname, __LINE__ ) 221 219 222 220 ! Get indices of data in theoretical profile … … 275 273 EXIT 276 274 ENDIF 277 END DO275 END DO 278 276 279 277 ! Close the file … … 290 288 DO jk = 1, icycles 291 289 jm = jm + 1 292 zjuld(jm) = zbegindates(jk,jj) + & 293 & (ipdataindexes(jl) * zdeltat / 86400._wp ) 290 IF (zbegindates(jk,jj)==zbeginmiss) THEN 291 llskip(jm) = .TRUE. 292 zjuld(jm) = fbrmdi 293 ELSE 294 llskip(jm) = .FALSE. 295 zjuld(jm) = zbegindates(jk,jj) + & 296 & (ipdataindexes(jl) * zdeltat / 86400._wp ) 297 ENDIF 294 298 END DO 295 299 END DO 296 300 END DO 301 302 ! Get rid of missing data 303 304 jm = 0 305 DO jobs = 1, idata 306 DO jcycle = 1, icycles 307 jm = jm + 1 308 IF (zsla(jcycle,jobs) == fbrmdi) llskip(jm) = .TRUE. 309 END DO 310 END DO 297 311 298 312 ! Allocate obfbdata 299 300 iobs = idata * icycles313 314 iobs = COUNT( .NOT.llskip(:) ) 301 315 CALL init_obfbdata( inpfile ) 302 316 CALL alloc_obfbdata( inpfile, 1, iobs, 1, 0, 0, ldgrid ) … … 307 321 inpfile%cdjuldref = cdjuldref 308 322 iobs = 0 323 jm = 0 309 324 DO jobs = 1, idata 310 325 DO jcycle = 1, icycles 326 jm = jm + 1 327 IF (llskip(jm)) CYCLE 311 328 iobs = iobs + 1 312 329 ! Characters … … 317 334 inpfile%pphi(iobs) = zphi(jobs) 318 335 inpfile%pob(1,iobs,1) = zsla(jcycle,jobs) 319 inpfile%ptim(iobs) = zjuld( iobs)336 inpfile%ptim(iobs) = zjuld(jm) 320 337 inpfile%pdep(1,iobs) = 0.0 321 338 ! Integers 322 339 inpfile%kindex(iobs) = iobs 323 IF ( zsla(jcycle,jobs) == fbrmdi ) THEN 324 inpfile%ioqc(iobs) = 4 325 inpfile%ivqc(iobs,1) = 4 326 inpfile%ivlqc(1,iobs,1) = 4 327 ELSE 328 inpfile%ioqc(iobs) = 1 329 inpfile%ivqc(iobs,1) = 1 330 inpfile%ivlqc(1,iobs,1) = 1 331 ENDIF 340 inpfile%ioqc(iobs) = 1 341 inpfile%ivqc(iobs,1) = 1 342 inpfile%ivlqc(1,iobs,1) = 1 332 343 inpfile%ipqc(iobs) = 0 333 344 inpfile%ipqcf(:,iobs) = 0 … … 354 365 & ipdataindexes, & 355 366 & zsla, & 356 & zjuld & 367 & zjuld, & 368 & llskip & 357 369 & ) 358 370 -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_sla_types.h90
r2001 r2074 1 INTEGER, PARAMETER :: & 2 & imaxmissions=7 1 INTEGER, PARAMETER :: imaxmissions=8 3 2 CHARACTER(len=3) :: cmissions(0:imaxmissions) = & 4 & (/ 'XXX', 'E1 ', 'E2 ', 'TP ', 'TPM', 'G2 ', 'J1 ', 'EN ' /)3 & (/ 'XXX', 'E1 ', 'E2 ', 'TP ', 'TPM', 'G2 ', 'J1 ', 'EN ', 'J2 ' /) -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_sort.F90
r2001 r2074 38 38 39 39 !! * Arguments 40 INTEGER, INTENT(IN) :: & 41 & kvals ! Number of elements to be sorted 40 INTEGER, INTENT(IN) :: kvals ! Number of elements to be sorted 42 41 REAL(KIND=dp), DIMENSION(kvals), INTENT(IN) :: & 43 42 & pvals ! Array to be sorted … … 76 75 77 76 !! * Arguments 78 INTEGER, INTENT(IN) :: & 79 & kvals ! Number of values 77 INTEGER, INTENT(IN) :: kvals ! Number of values 80 78 REAL(KIND=dp), DIMENSION(kvals), INTENT(IN) :: & 81 79 & pval ! Array to be sorted … … 84 82 85 83 !! * Local declarations 86 INTEGER :: & 87 & ji, & 88 & jj, & 89 & jt, & 90 & jn, & 91 & jparent, & 92 & jchild 84 INTEGER :: ji 85 INTEGER :: jj 86 INTEGER :: jt 87 INTEGER :: jn 88 INTEGER :: jparent 89 INTEGER :: jchild 93 90 94 91 DO ji = 1, kvals -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_sst_io.h90
r2001 r2074 23 23 !! * Local declarations 24 24 CHARACTER(LEN=12),PARAMETER :: cpname = 'read_ghrsst' 25 INTEGER :: & 26 & i_file_id, & ! netcdf IDS 27 & i_time_id, & 28 & i_ni_id, & 29 & i_data_id, & 30 & i_var_id 31 INTEGER :: & 32 & i_data, & ! Number of data per parameter in current file 33 & i_time ! Number of reference times in file 25 INTEGER :: i_file_id ! netcdf IDS 26 INTEGER :: i_time_id 27 INTEGER :: i_ni_id 28 INTEGER :: i_data_id 29 INTEGER :: i_var_id 30 INTEGER :: i_data ! Number of data per parameter in current file 31 INTEGER :: i_time ! Number of reference times in file 34 32 INTEGER, DIMENSION(:), POINTER :: & 35 33 & i_reftime ! Reference time in file in seconds since 1/1/1981. … … 43 41 REAL(wp), DIMENSION(:,:), POINTER :: & 44 42 & z_sst ! SST data 45 INTEGER, PARAMETER :: & 46 & imaxdim = 2 ! Assumed maximum for no. dims. in file 47 INTEGER, DIMENSION(2) :: & 48 & idims ! Dimensions in file 49 INTEGER :: & 50 & iilen, & ! Length of netCDF attributes 51 & itype ! Typeof netCDF attributes 52 REAL(KIND=wp) :: & 53 & zsca, & ! Scale factor 54 & zoff, & ! Offset for data in netcdf file 55 & z_offset, & ! Offset for time conversion 56 & zfill ! Fill value in netcdf file 57 CHARACTER (len=33) :: & 58 & creftime ! Reference time of file 59 INTEGER :: & 60 & i_refyear, & ! Integer version of reference time 61 & i_refmonth, & 62 & i_refday, & 63 & i_refhour, & 64 & i_refmin, & 65 & i_refsec 66 INTEGER :: & 67 & ichunk 68 integer :: & 69 & jtim, & 70 & jobs, & 71 & iobs 43 INTEGER, PARAMETER :: imaxdim = 2 ! Assumed maximum for no. dims. in file 44 INTEGER, DIMENSION(2) :: idims ! Dimensions in file 45 INTEGER :: iilen ! Length of netCDF attributes 46 INTEGER :: itype ! Typeof netCDF attributes 47 REAL(KIND=wp) :: zsca ! Scale factor 48 REAL(KIND=wp) :: zoff ! Offset for data in netcdf file 49 REAL(KIND=wp) :: z_offset ! Offset for time conversion 50 REAL(KIND=wp) :: zfill ! Fill value in netcdf file 51 CHARACTER (len=33) :: creftime ! Reference time of file 52 INTEGER :: i_refyear ! Integer version of reference time 53 INTEGER :: i_refmonth 54 INTEGER :: i_refday 55 INTEGER :: i_refhour 56 INTEGER :: i_refmin 57 INTEGER :: i_refsec 58 INTEGER :: ichunk 59 INTEGER :: jtim 60 INTEGER :: jobs 61 INTEGER :: iobs 72 62 73 63 CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, & -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_surf_def.F90
r2001 r2074 42 42 ! Bookkeeping 43 43 44 INTEGER :: & 45 & nsurf, & !: Local number of surface data within window 46 & nsurfmpp, & !: Global number of surface data within window 47 & nvar, & !: Number of variables at observation points 48 & nextra, & !: Number of extra fields at observation points 49 & nstp, & !: Number of time steps 50 & nsurfup !: Observation counter used in obs_oper 44 INTEGER :: nsurf !: Local number of surface data within window 45 INTEGER :: nsurfmpp !: Global number of surface data within window 46 INTEGER :: nvar !: Number of variables at observation points 47 INTEGER :: nextra !: Number of extra fields at observation points 48 INTEGER :: nstp !: Number of time steps 49 INTEGER :: nsurfup !: Observation counter used in obs_oper 51 50 52 51 ! Arrays with size equal to the number of surface observations … … 65 64 & nqc, & !: Surface observation qc flag 66 65 & ntyp !: Type of surface observation product 66 67 CHARACTER(LEN=8), POINTER, DIMENSION(:) :: & 68 & cwmo !: WMO indentifier 67 69 68 70 REAL(KIND=wp), POINTER, DIMENSION(:) :: & … … 107 109 !!---------------------------------------------------------------------- 108 110 !! * Arguments 109 TYPE(obs_surf), INTENT(INOUT) :: & 110 & surf ! Surface data to be allocated 111 INTEGER, INTENT(IN) :: & 112 & ksurf, & ! Number of surface observations 113 & kvar, & ! Number of surface variables 114 & kextra, & ! Number of extra fields at observation points 115 & kstp ! Number of time steps 111 TYPE(obs_surf), INTENT(INOUT) :: surf ! Surface data to be allocated 112 INTEGER, INTENT(IN) :: ksurf ! Number of surface observations 113 INTEGER, INTENT(IN) :: kvar ! Number of surface variables 114 INTEGER, INTENT(IN) :: kextra ! Number of extra fields at observation points 115 INTEGER, INTENT(IN) :: kstp ! Number of time steps 116 116 117 117 !!* Local variables 118 INTEGER :: & 119 & ji 118 INTEGER :: ji 120 119 121 120 ! Set bookkeeping variables … … 142 141 & surf%nqc(ksurf), & 143 142 & surf%ntyp(ksurf), & 143 & surf%cwmo(ksurf), & 144 144 & surf%rlam(ksurf), & 145 145 & surf%rphi(ksurf), & … … 217 217 & surf%nqc, & 218 218 & surf%ntyp, & 219 & surf%cwmo, & 219 220 & surf%rlam, & 220 221 & surf%rphi, & … … 263 264 !!---------------------------------------------------------------------- 264 265 !! * Arguments 265 TYPE(obs_surf), INTENT(IN) :: & 266 & surf ! Original surface data 267 TYPE(obs_surf), INTENT(INOUT) :: & 268 & newsurf ! New surface data with a subset of the original data 269 LOGICAL :: & 270 & lallocate ! Allocate newsurf data 271 INTEGER,INTENT(IN) :: & 272 & kumout ! Fortran unit for messages 266 TYPE(obs_surf), INTENT(IN) :: surf ! Original surface data 267 TYPE(obs_surf), INTENT(INOUT) :: newsurf ! New surface data with a subset of the original data 268 LOGICAL :: lallocate ! Allocate newsurf data 269 INTEGER,INTENT(IN) :: kumout ! Fortran unit for messages 273 270 LOGICAL, OPTIONAL, INTENT(in), DIMENSION(:) :: & 274 271 & lvalid ! Valid of surface observations 275 272 276 273 !!* Local variables 277 INTEGER :: & 278 & insurf 279 INTEGER :: & 280 & ji, & 281 & jk 282 LOGICAL, DIMENSION(:), ALLOCATABLE :: & 283 & llvalid 274 INTEGER :: insurf 275 INTEGER :: ji 276 INTEGER :: jk 277 LOGICAL, DIMENSION(:), ALLOCATABLE :: llvalid 284 278 285 279 ! Count how many elements there should be in the new data structure … … 338 332 newsurf%nqc(insurf) = surf%nqc(ji) 339 333 newsurf%ntyp(insurf) = surf%ntyp(ji) 334 newsurf%cwmo(insurf) = surf%cwmo(ji) 340 335 newsurf%rlam(insurf) = surf%rlam(ji) 341 336 newsurf%rphi(insurf) = surf%rphi(ji) … … 352 347 newsurf%rext(insurf,jk) = surf%rext(ji,jk) 353 348 354 END DO349 END DO 355 350 356 351 ! nsind is the index of the original surface data … … 392 387 !!---------------------------------------------------------------------- 393 388 !! * Arguments 394 TYPE(obs_surf),INTENT(INOUT) :: & 395 & surf ! Updated surface data 396 TYPE(obs_surf),INTENT(INOUT) :: & 397 & oldsurf ! Original surface data 398 LOGICAL :: & 399 & ldeallocate ! Deallocate the updated data of insertion 400 INTEGER,INTENT(in) :: & 401 & kumout ! Output unit 389 TYPE(obs_surf),INTENT(INOUT) :: surf ! Updated surface data 390 TYPE(obs_surf),INTENT(INOUT) :: oldsurf ! Original surface data 391 LOGICAL :: ldeallocate ! Deallocate the updated data of insertion 392 INTEGER,INTENT(in) :: kumout ! Output unit 402 393 403 394 !!* Local variables 404 INTEGER :: & 405 & ji, & 406 & jj, & 407 & jk 395 INTEGER :: ji 396 INTEGER :: jj 397 INTEGER :: jk 408 398 409 399 ! Copy data from surf to old surf … … 425 415 oldsurf%nqc(jj) = surf%nqc(ji) 426 416 oldsurf%ntyp(jj) = surf%ntyp(ji) 417 oldsurf%cwmo(jj) = surf%cwmo(ji) 427 418 oldsurf%rlam(jj) = surf%rlam(ji) 428 419 oldsurf%rphi(jj) = surf%rphi(ji) … … 439 430 oldsurf%rmod(jj,jk) = surf%rmod(ji,jk) 440 431 441 END DO442 443 END DO432 END DO 433 434 END DO 444 435 445 436 DO jk = 1, surf%nextra … … 451 442 oldsurf%rext(jj,jk) = surf%rext(ji,jk) 452 443 453 END DO454 455 END DO444 END DO 445 446 END DO 456 447 457 448 ! Optionally deallocate the updated surface data -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_types.F90
r2001 r2074 40 40 CHARACTER(LEN=3), PUBLIC, DIMENSION(0:ntyp1770) :: ctypshort 41 41 42 INTEGER, PUBLIC, PARAMETER :: ntypalt = 742 INTEGER, PUBLIC, PARAMETER :: ntypalt = 8 43 43 CHARACTER(LEN=40), PUBLIC, DIMENSION(0:ntypalt) :: calttyp 44 44 … … 106 106 107 107 !! * Local declarations 108 INTEGER :: & 109 & ji 108 INTEGER :: ji 110 109 111 110 DO ji = 0, ntyp1770 … … 190 189 DO ji = 853, 854 191 190 cwmonam1770(ji) = 'Reserved' 192 END DO191 END DO 193 192 194 193 DO ji = 859, 899 195 194 cwmonam1770(ji) = 'Reserved' 196 END DO195 END DO 197 196 198 197 DO ji = 901, 999 199 198 cwmonam1770(ji) = 'Reserved' 200 END DO199 END DO 201 200 202 201 DO ji = 1000, 1022 203 202 cwmonam1770(ji) = 'Reserved' 204 END DO203 END DO 205 204 206 205 ctypshort(800) = 'MBT' … … 256 255 calttyp(6) = 'Jason-1' 257 256 calttyp(7) = 'Envisat' 258 257 calttyp(8) = 'Jason-2' 258 259 259 END SUBROUTINE obs_alt_typ_init 260 260 -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_utils.F90
r2001 r2074 63 63 64 64 !! * Arguments 65 INTEGER :: & 66 & kstatus, & 67 & klineno 68 CHARACTER(LEN=*) :: & 69 & cd_name 70 71 !! * Local declarations 72 CHARACTER(len=200) :: & 73 & clineno 65 INTEGER :: kstatus 66 INTEGER :: klineno 67 CHARACTER(LEN=*) :: cd_name 68 69 !! * Local declarations 70 CHARACTER(len=200) :: clineno 74 71 75 72 ! Main computation … … 102 99 103 100 !! * Arguments 104 INTEGER :: & 105 & kfileid, & ! NetCDF file id 106 & kvarid, & ! NetCDF variable id 107 & kndim ! Expected number of dimensions 108 INTEGER, DIMENSION(kndim) :: & 109 & kdim ! Expected dimensions 110 CHARACTER(LEN=*) :: & 111 & cd_name ! Calling routine name 112 INTEGER :: & 113 & klineno ! Calling line number 114 115 !! * Local declarations 116 INTEGER :: & 117 & indim 101 INTEGER :: kfileid ! NetCDF file id 102 INTEGER :: kvarid ! NetCDF variable id 103 INTEGER :: kndim ! Expected number of dimensions 104 INTEGER, DIMENSION(kndim) :: kdim ! Expected dimensions 105 CHARACTER(LEN=*) :: cd_name ! Calling routine name 106 INTEGER :: klineno ! Calling line number 107 108 !! * Local declarations 109 INTEGER :: indim 118 110 INTEGER, ALLOCATABLE, DIMENSION(:) :: & 119 111 & idim,ilendim 120 INTEGER :: & 121 & ji 122 LOGICAL :: & 123 & llerr 124 CHARACTER(len=200) :: & 125 & clineno 126 112 INTEGER :: ji 113 LOGICAL :: llerr 114 CHARACTER(len=200) :: clineno 127 115 128 116 CALL chkerr( nf90_inquire_variable( kfileid, kvarid, ndims=indim ), & … … 176 164 177 165 !! * Arguments 178 INTEGER :: & 179 & klineno 180 CHARACTER(LEN=*) :: & 181 & cd_name 182 !! * Local declarations 183 CHARACTER(len=200) :: & 184 & clineno 166 INTEGER :: klineno 167 CHARACTER(LEN=*) :: cd_name 168 !! * Local declarations 169 CHARACTER(len=200) :: clineno 185 170 186 171 WRITE(clineno,'(A,I8)')' at line number ', klineno … … 206 191 207 192 !! * Arguments 208 INTEGER :: & 209 & klineno 210 CHARACTER(LEN=*) :: & 211 & cd_name 212 !! * Local declarations 213 CHARACTER(len=200) :: & 214 & clineno 193 INTEGER :: klineno 194 CHARACTER(LEN=*) :: cd_name 195 !! * Local declarations 196 CHARACTER(len=200) :: clineno 215 197 216 198 WRITE(clineno,'(A,I8)')' at line number ', klineno -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_vel_io.h90
r2001 r2074 21 21 LOGICAL :: ldgrid ! Save grid info in data structure 22 22 !! * Local declarations 23 INTEGER :: & 24 & iobs, & ! Number of observations 25 & ilev, & ! Number of levels 26 & ilat, & ! Number of latitudes 27 & ilon, & ! Number of longtudes 28 & itim ! Number of obs. times 29 INTEGER :: & 30 & i_file_id, & 31 & i_dimid_id, & 32 & i_phi_id, & 33 & i_lam_id, & 34 & i_depth_id, & 35 & i_var_id, & 36 & i_time_id, & 37 & i_time2_id, & 38 & i_qc_var_id 39 CHARACTER(LEN=40) :: & 40 & cl_fld_lam, & 41 & cl_fld_phi, & 42 & cl_fld_depth, & 43 & cl_fld_var_u, & 44 & cl_fld_var_v, & 45 & cl_fld_var_qc_uv1, & 46 & cl_fld_var_qc_uv2, & 47 & cl_fld_time, & 48 & cl_fld_time2 49 INTEGER :: & 50 & ja, & 51 & jo, & 52 & jk, & 53 & jt 23 INTEGER :: iobs ! Number of observations 24 INTEGER :: ilev ! Number of levels 25 INTEGER :: ilat ! Number of latitudes 26 INTEGER :: ilon ! Number of longtudes 27 INTEGER :: itim ! Number of obs. times 28 INTEGER :: i_file_id 29 INTEGER :: i_dimid_id 30 INTEGER :: i_phi_id 31 INTEGER :: i_lam_id 32 INTEGER :: i_depth_id 33 INTEGER :: i_var_id 34 INTEGER :: i_time_id 35 INTEGER :: i_time2_id 36 INTEGER :: i_qc_var_id 37 CHARACTER(LEN=40) :: cl_fld_lam 38 CHARACTER(LEN=40) :: cl_fld_phi 39 CHARACTER(LEN=40) :: cl_fld_depth 40 CHARACTER(LEN=40) :: cl_fld_var_u 41 CHARACTER(LEN=40) :: cl_fld_var_v 42 CHARACTER(LEN=40) :: cl_fld_var_qc_uv1 43 CHARACTER(LEN=40) :: cl_fld_var_qc_uv2 44 CHARACTER(LEN=40) :: cl_fld_time 45 CHARACTER(LEN=40) :: cl_fld_time2 46 INTEGER :: ja 47 INTEGER :: jo 48 INTEGER :: jk 49 INTEGER :: jt 54 50 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: & 55 51 & zv, & … … 62 58 & zlon, & 63 59 & zjuld 64 REAL(wp) :: & 65 & zl 60 REAL(wp) :: zl 66 61 INTEGER, ALLOCATABLE, DIMENSION(:) :: & 67 62 & itime, & 68 63 & itime2 69 CHARACTER(LEN=50) :: & 70 & cdjulref 71 CHARACTER(LEN=12), PARAMETER :: & 72 & cl_name = 'read_taondbc' 64 CHARACTER(LEN=50) :: cdjulref 65 CHARACTER(LEN=12), PARAMETER :: cl_name = 'read_taondbc' 73 66 CHARACTER(len=1) :: cns, cew 74 67 … … 252 245 zjuld(jt) = REAL(itime(jt),wp) + REAL(itime2(jt),wp)/86400000.0_wp & 253 246 & - 2433283.0_wp 254 END DO247 END DO 255 248 inpfile%cdjuldref = '19500101000000' 256 249 … … 283 276 inpfile%pdep(jk,iobs) = zdep(jk) 284 277 inpfile%ivlqc(jk,iobs,1:2) = INT( MAX( zuv1qc(jo,ja,jk,jt), zuv2qc(jo,ja,jk,jt) ) ) 285 END DO278 END DO 286 279 inpfile%plam(iobs) = zlon(jo) 287 280 inpfile%pphi(iobs) = zlat(ja) 288 281 inpfile%ptim(iobs) = zjuld(jt) 289 END DO290 END DO291 END DO282 END DO 283 END DO 284 END DO 292 285 293 286 ! No position, time, depth and variable QC in input files … … 298 291 DO jk = 1, ilev 299 292 inpfile%idqc(jk,jo) = 1 300 END DO301 END DO293 END DO 294 END DO 302 295 303 296 !--------------------------------------------------------------------- … … 321 314 inpfile%pob(jk,jo,2) = 0.01 * inpfile%pob(jk,jo,2) 322 315 ENDIF 323 END DO324 END DO316 END DO 317 END DO 325 318 326 319 !--------------------------------------------------------------------- … … 330 323 DO jo = 1, inpfile%nobs 331 324 inpfile%kindex(jo) = jo 332 END DO325 END DO 333 326 334 327 !--------------------------------------------------------------------- -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/obs_write.F90
r2001 r2074 41 41 & obs_wri_sss, & ! Write SSS observation related diagnostics 42 42 & obs_wri_seaice, & ! Write seaice observation related diagnostics 43 & obs_wri_vel ! Write velocity observation related diagnostics 43 & obs_wri_vel, & ! Write velocity observation related diagnostics 44 & obswriinfo 45 46 TYPE obswriinfo 47 INTEGER :: inum 48 INTEGER, POINTER, DIMENSION(:) :: ipoint 49 CHARACTER(len=ilenname), POINTER, DIMENSION(:) :: cdname 50 CHARACTER(len=ilenlong), POINTER, DIMENSION(:,:) :: cdlong 51 CHARACTER(len=ilenunit), POINTER, DIMENSION(:,:) :: cdunit 52 END TYPE obswriinfo 44 53 45 54 CONTAINS 46 55 47 SUBROUTINE obs_wri_p3d( cprefix, profdata )56 SUBROUTINE obs_wri_p3d( cprefix, profdata, padd, pext ) 48 57 !!----------------------------------------------------------------------- 49 58 !! … … 69 78 70 79 !! * Arguments 71 CHARACTER(LEN=*), INTENT(IN) :: &72 & cprefix ! Prefix for output files73 TYPE(obs _prof), INTENT(INOUT) :: &74 & profdata ! Full set of profile data75 80 CHARACTER(LEN=*), INTENT(IN) :: cprefix ! Prefix for output files 81 TYPE(obs_prof), INTENT(INOUT) :: profdata ! Full set of profile data 82 TYPE(obswriinfo), OPTIONAL :: padd ! Additional info for each variable 83 TYPE(obswriinfo), OPTIONAL :: pext ! Extra info 84 76 85 !! * Local declarations 77 86 TYPE(obfbdata) :: fbdata 78 CHARACTER(LEN=40) :: & 79 & cfname 80 INTEGER :: & 81 & ilevel 82 INTEGER :: & 83 & jvar, & 84 & jo, & 85 & jk, & 86 & ik 87 REAL(wp) :: & 88 & zpres 89 87 CHARACTER(LEN=40) :: cfname 88 INTEGER :: ilevel 89 INTEGER :: jvar 90 INTEGER :: jo 91 INTEGER :: jk 92 INTEGER :: ik 93 INTEGER :: ja 94 INTEGER :: je 95 REAL(wp) :: zpres 96 INTEGER :: nadd 97 INTEGER :: next 98 99 IF ( PRESENT( padd ) ) THEN 100 nadd = padd%inum 101 ELSE 102 nadd = 0 103 ENDIF 104 105 IF ( PRESENT( pext ) ) THEN 106 next = pext%inum 107 ELSE 108 next = 0 109 ENDIF 110 90 111 CALL init_obfbdata( fbdata ) 91 112 … … 94 115 DO jvar = 1, 2 95 116 ilevel = MAX( ilevel, MAXVAL( profdata%var(jvar)%nvlidx(:) ) ) 96 ENDDO 97 CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, 1, 1, .TRUE. ) 117 END DO 118 CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, & 119 & 1 + nadd, 1 + next, .TRUE. ) 98 120 99 121 fbdata%cname(1) = 'POTM' … … 101 123 fbdata%coblong(1) = 'Potential temperature' 102 124 fbdata%coblong(2) = 'Practical salinity' 103 fbdata%cobunit(1) = 'Degrees Celsius'125 fbdata%cobunit(1) = 'Degrees centigrade' 104 126 fbdata%cobunit(2) = 'PSU' 105 127 fbdata%cextname(1) = 'TEMP' 106 128 fbdata%cextlong(1) = 'Insitu temperature' 107 fbdata%cextunit(1) = 'Degrees Celsius' 129 fbdata%cextunit(1) = 'Degrees centigrade' 130 DO je = 1, next 131 fbdata%cextname(1+je) = pext%cdname(je) 132 fbdata%cextlong(1+je) = pext%cdlong(je,1) 133 fbdata%cextunit(1+je) = pext%cdunit(je,1) 134 END DO 108 135 fbdata%caddname(1) = 'Hx' 109 136 fbdata%caddlong(1,1) = 'Model interpolated potential temperature' 110 137 fbdata%caddlong(1,2) = 'Model interpolated practical salinity' 111 fbdata%caddunit(1,1) = 'Degrees Celsius'138 fbdata%caddunit(1,1) = 'Degrees centigrade' 112 139 fbdata%caddunit(1,2) = 'PSU' 113 140 fbdata%cgrid(:) = 'T' 141 DO ja = 1, nadd 142 fbdata%caddname(1+ja) = padd%cdname(ja) 143 DO jvar = 1, 2 144 fbdata%caddlong(1+ja,jvar) = padd%cdlong(ja,jvar) 145 fbdata%caddunit(1+ja,jvar) = padd%cdunit(ja,jvar) 146 END DO 147 END DO 148 114 149 WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc 115 150 … … 151 186 fbdata%iobsj(jo,jvar) = mjg(profdata%mj(jo,jvar)) 152 187 ENDIF 153 END DO188 END DO 154 189 CALL greg2jul( 0, & 155 190 & profdata%nmin(jo), & … … 178 213 ENDIF 179 214 fbdata%iobsk(ik,jo,jvar) = profdata%var(jvar)%mvk(jk) 215 DO ja = 1, nadd 216 fbdata%padd(ik,jo,1+ja,jvar) = & 217 & profdata%var(jvar)%vext(jk,padd%ipoint(ja)) 218 END DO 219 DO je = 1, next 220 fbdata%pext(ik,jo,1+je) = & 221 & profdata%var(jvar)%vext(jk,pext%ipoint(je)) 222 END DO 180 223 IF ( jvar == 1 ) THEN 181 224 fbdata%pext(ik,jo,1) = profdata%var(jvar)%vext(jk,1) … … 201 244 & zpres, 0.0_wp ) 202 245 ENDIF 203 END DO204 ENDIF 205 END DO246 END DO 247 ENDIF 248 END DO 206 249 207 250 ! Write the obfbdata structure … … 212 255 END SUBROUTINE obs_wri_p3d 213 256 214 SUBROUTINE obs_wri_sla( cprefix, sladata )257 SUBROUTINE obs_wri_sla( cprefix, sladata, padd, pext ) 215 258 !!----------------------------------------------------------------------- 216 259 !! … … 232 275 233 276 !! * Arguments 234 CHARACTER(LEN=*), INTENT(IN) :: &235 & cprefix ! Prefix for output files236 TYPE(obs _surf), INTENT(INOUT) :: &237 & sladata ! Full set of SLAa277 CHARACTER(LEN=*), INTENT(IN) :: cprefix ! Prefix for output files 278 TYPE(obs_surf), INTENT(INOUT) :: sladata ! Full set of SLAa 279 TYPE(obswriinfo), OPTIONAL :: padd ! Additional info for each variable 280 TYPE(obswriinfo), OPTIONAL :: pext ! Extra info 238 281 239 282 !! * Local declarations 240 283 TYPE(obfbdata) :: fbdata 241 CHARACTER(LEN=40) :: & 242 & cfname ! netCDF filename 243 CHARACTER(LEN=12), PARAMETER :: & 244 & cpname = 'obs_wri_sla' 245 INTEGER :: & 246 & jo 284 CHARACTER(LEN=40) :: cfname ! netCDF filename 285 CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_sla' 286 INTEGER :: jo 287 INTEGER :: ja 288 INTEGER :: je 289 INTEGER :: nadd 290 INTEGER :: next 291 292 IF ( PRESENT( padd ) ) THEN 293 nadd = padd%inum 294 ELSE 295 nadd = 0 296 ENDIF 297 298 IF ( PRESENT( pext ) ) THEN 299 next = pext%inum 300 ELSE 301 next = 0 302 ENDIF 247 303 248 304 CALL init_obfbdata( fbdata ) 249 305 250 CALL alloc_obfbdata( fbdata, 1, sladata%nsurf, 1, 1, 2, .TRUE. ) 306 CALL alloc_obfbdata( fbdata, 1, sladata%nsurf, 1, & 307 & 2 + nadd, 1 + next, .TRUE. ) 251 308 252 309 fbdata%cname(1) = 'SLA' 253 310 fbdata%coblong(1) = 'Sea level anomaly' 254 fbdata%cobunit(1) = 'metre' 255 fbdata%cextname(1) = 'SSH' 256 fbdata%cextlong(1) = 'Model Sea surface height' 257 fbdata%cextunit(1) = 'metre' 258 fbdata%cextname(2) = 'MDT' 259 fbdata%cextlong(2) = 'Mean dynamic topography' 260 fbdata%cextunit(2) = 'metre' 311 fbdata%cobunit(1) = 'Metres' 312 fbdata%cextname(1) = 'MDT' 313 fbdata%cextlong(1) = 'Mean dynamic topography' 314 fbdata%cextunit(1) = 'Metres' 315 DO je = 1, next 316 fbdata%cextname(1+je) = pext%cdname(je) 317 fbdata%cextlong(1+je) = pext%cdlong(je,1) 318 fbdata%cextunit(1+je) = pext%cdunit(je,1) 319 END DO 261 320 fbdata%caddname(1) = 'Hx' 262 321 fbdata%caddlong(1,1) = 'Model interpolated SSH - MDT' 263 fbdata%caddunit(1,1) = 'metre' 322 fbdata%caddunit(1,1) = 'Metres' 323 fbdata%caddname(2) = 'SSH' 324 fbdata%caddlong(2,1) = 'Model Sea surface height' 325 fbdata%caddunit(2,1) = 'Metres' 264 326 fbdata%cgrid(1) = 'T' 327 DO ja = 1, nadd 328 fbdata%caddname(2+ja) = padd%cdname(ja) 329 fbdata%caddlong(2+ja,1) = padd%cdlong(ja,1) 330 fbdata%caddunit(2+ja,1) = padd%cdunit(ja,1) 331 END DO 265 332 266 333 WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc … … 293 360 fbdata%itqc(jo) = 0 294 361 fbdata%itqcf(:,jo) = 0 295 fbdata%cdwmo(jo) = cmissions(sladata%ntyp(jo))362 fbdata%cdwmo(jo) = sladata%cwmo(jo) 296 363 fbdata%kindex(jo) = sladata%nsfil(jo) 297 364 IF (ln_grid_global) THEN … … 311 378 & krefdate = 19500101 ) 312 379 fbdata%padd(1,jo,1,1) = sladata%rmod(jo,1) 313 fbdata%pob(1,jo,1) = sladata%robs(jo,1) 380 fbdata%padd(1,jo,2,1) = sladata%rext(jo,1) 381 fbdata%pob(1,jo,1) = sladata%robs(jo,1) 314 382 fbdata%pdep(1,jo) = 0.0 315 383 fbdata%idqc(1,jo) = 0 316 384 fbdata%idqcf(:,1,jo) = 0 317 385 IF ( sladata%nqc(jo) > 10 ) THEN 318 fbdata%ivlqc(1,jo,1) = 4 386 fbdata%ivqc(jo,1) = 4 387 fbdata%ivlqc(1,jo,1) = 4 319 388 fbdata%ivlqcf(1,1,jo,1) = 0 320 389 fbdata%ivlqcf(2,1,jo,1) = sladata%nqc(jo) - 10 321 390 ELSE 322 fbdata%ivlqc(1,jo,1) = sladata%nqc(jo) 391 fbdata%ivqc(jo,1) = sladata%nqc(jo) 392 fbdata%ivlqc(1,jo,1) = sladata%nqc(jo) 323 393 fbdata%ivlqcf(:,1,jo,1) = 0 324 394 ENDIF 325 395 fbdata%iobsk(1,jo,1) = 0 326 fbdata%pext(1,jo,1) = sladata%rext(jo,1) 327 fbdata%pext(1,jo,2) = sladata%rext(jo,2) 328 396 fbdata%pext(1,jo,1) = sladata%rext(jo,2) 397 DO ja = 1, nadd 398 fbdata%padd(1,jo,2+ja,1) = & 399 & sladata%rext(jo,padd%ipoint(ja)) 400 END DO 401 DO je = 1, next 402 fbdata%pext(1,jo,1+je) = & 403 & sladata%rext(jo,pext%ipoint(je)) 404 END DO 329 405 END DO 330 406 … … 336 412 END SUBROUTINE obs_wri_sla 337 413 338 SUBROUTINE obs_wri_sst( cprefix, sstdata )414 SUBROUTINE obs_wri_sst( cprefix, sstdata, padd, pext ) 339 415 !!----------------------------------------------------------------------- 340 416 !! … … 356 432 357 433 !! * Arguments 358 CHARACTER(LEN=*), INTENT(IN) :: &359 & cprefix ! Prefix for output files360 TYPE(obs _surf), INTENT(INOUT) :: &361 & sstdata ! Full set of SST434 CHARACTER(LEN=*), INTENT(IN) :: cprefix ! Prefix for output files 435 TYPE(obs_surf), INTENT(INOUT) :: sstdata ! Full set of SST 436 TYPE(obswriinfo), OPTIONAL :: padd ! Additional info for each variable 437 TYPE(obswriinfo), OPTIONAL :: pext ! Extra info 362 438 363 439 !! * Local declarations 364 440 TYPE(obfbdata) :: fbdata 365 CHARACTER(LEN=40) :: & 366 & cfname ! netCDF filename 367 CHARACTER(LEN=12), PARAMETER :: & 368 & cpname = 'obs_wri_sst' 369 INTEGER :: & 370 & jo 441 CHARACTER(LEN=40) :: cfname ! netCDF filename 442 CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_sst' 443 INTEGER :: jo 444 INTEGER :: ja 445 INTEGER :: je 446 INTEGER :: nadd 447 INTEGER :: next 448 449 IF ( PRESENT( padd ) ) THEN 450 nadd = padd%inum 451 ELSE 452 nadd = 0 453 ENDIF 454 455 IF ( PRESENT( pext ) ) THEN 456 next = pext%inum 457 ELSE 458 next = 0 459 ENDIF 371 460 372 461 CALL init_obfbdata( fbdata ) 373 462 374 CALL alloc_obfbdata( fbdata, 1, sstdata%nsurf, 1, 1, 0, .TRUE. ) 463 CALL alloc_obfbdata( fbdata, 1, sstdata%nsurf, 1, & 464 & 1 + nadd, next, .TRUE. ) 375 465 376 466 fbdata%cname(1) = 'SST' 377 467 fbdata%coblong(1) = 'Sea surface temperature' 378 468 fbdata%cobunit(1) = 'Degree centigrade' 469 DO je = 1, next 470 fbdata%cextname(je) = pext%cdname(je) 471 fbdata%cextlong(je) = pext%cdlong(je,1) 472 fbdata%cextunit(je) = pext%cdunit(je,1) 473 END DO 379 474 fbdata%caddname(1) = 'Hx' 380 475 fbdata%caddlong(1,1) = 'Model interpolated SST' 381 476 fbdata%caddunit(1,1) = 'Degree centigrade' 477 fbdata%cgrid(1) = 'T' 478 DO ja = 1, nadd 479 fbdata%caddname(1+ja) = padd%cdname(ja) 480 fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 481 fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 482 END DO 382 483 383 484 WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc … … 433 534 fbdata%idqcf(:,1,jo) = 0 434 535 IF ( sstdata%nqc(jo) > 10 ) THEN 435 fbdata%ivlqc(1,jo,1) = 4 536 fbdata%ivqc(jo,1) = 4 537 fbdata%ivlqc(1,jo,1) = 4 436 538 fbdata%ivlqcf(1,1,jo,1) = 0 437 539 fbdata%ivlqcf(2,1,jo,1) = sstdata%nqc(jo) - 10 438 540 ELSE 439 fbdata%ivlqc(1,jo,1) = MAX(sstdata%nqc(jo),1) 541 fbdata%ivqc(jo,1) = MAX(sstdata%nqc(jo),1) 542 fbdata%ivlqc(1,jo,1) = MAX(sstdata%nqc(jo),1) 440 543 fbdata%ivlqcf(:,1,jo,1) = 0 441 544 ENDIF 442 545 fbdata%iobsk(1,jo,1) = 0 546 DO ja = 1, nadd 547 fbdata%padd(1,jo,1+ja,1) = & 548 & sstdata%rext(jo,padd%ipoint(ja)) 549 END DO 550 DO je = 1, next 551 fbdata%pext(1,jo,je) = & 552 & sstdata%rext(jo,pext%ipoint(je)) 553 END DO 443 554 444 555 END DO 445 556 446 557 ! Write the obfbdata structure 558 447 559 CALL write_obfbdata( cfname, fbdata ) 448 560 … … 454 566 END SUBROUTINE obs_wri_sss 455 567 456 SUBROUTINE obs_wri_seaice( cprefix, seaicedata )568 SUBROUTINE obs_wri_seaice( cprefix, seaicedata, padd, pext ) 457 569 !!----------------------------------------------------------------------- 458 570 !! … … 474 586 475 587 !! * Arguments 476 CHARACTER(LEN=*), INTENT(IN) :: & 477 & cprefix ! Prefix for output files 478 TYPE(obs_surf), INTENT(INOUT) :: & 479 & seaicedata ! Full set of sea ice 588 CHARACTER(LEN=*), INTENT(IN) :: cprefix ! Prefix for output files 589 TYPE(obs_surf), INTENT(INOUT) :: seaicedata ! Full set of sea ice 590 TYPE(obswriinfo), OPTIONAL :: padd ! Additional info for each variable 591 TYPE(obswriinfo), OPTIONAL :: pext ! Extra info 592 593 !! * Local declarations 480 594 TYPE(obfbdata) :: fbdata 481 CHARACTER(LEN=40) :: & 482 & cfname ! netCDF filename 483 CHARACTER(LEN=12), PARAMETER :: & 484 & cpname = 'obs_wri_seaice' 485 INTEGER :: & 486 & jo 595 CHARACTER(LEN=40) :: cfname ! netCDF filename 596 CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_seaice' 597 INTEGER :: jo 598 INTEGER :: ja 599 INTEGER :: je 600 INTEGER :: nadd 601 INTEGER :: next 602 603 IF ( PRESENT( padd ) ) THEN 604 nadd = padd%inum 605 ELSE 606 nadd = 0 607 ENDIF 608 609 IF ( PRESENT( pext ) ) THEN 610 next = pext%inum 611 ELSE 612 next = 0 613 ENDIF 487 614 488 615 CALL init_obfbdata( fbdata ) … … 493 620 fbdata%coblong(1) = 'Sea ice' 494 621 fbdata%cobunit(1) = 'Fraction' 622 DO je = 1, next 623 fbdata%cextname(je) = pext%cdname(je) 624 fbdata%cextlong(je) = pext%cdlong(je,1) 625 fbdata%cextunit(je) = pext%cdunit(je,1) 626 END DO 495 627 fbdata%caddname(1) = 'Hx' 496 628 fbdata%caddlong(1,1) = 'Model interpolated ICE' 497 629 fbdata%caddunit(1,1) = 'Fraction' 630 fbdata%cgrid(1) = 'T' 631 DO ja = 1, nadd 632 fbdata%caddname(1+ja) = padd%cdname(ja) 633 fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 634 fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 635 END DO 498 636 499 637 WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc … … 557 695 ENDIF 558 696 fbdata%iobsk(1,jo,1) = 0 697 DO ja = 1, nadd 698 fbdata%padd(1,jo,1+ja,1) = & 699 & seaicedata%rext(jo,padd%ipoint(ja)) 700 END DO 701 DO je = 1, next 702 fbdata%pext(1,jo,je) = & 703 & seaicedata%rext(jo,pext%ipoint(je)) 704 END DO 559 705 560 706 END DO … … 565 711 CALL dealloc_obfbdata( fbdata ) 566 712 567 568 !! * Local declarations569 713 END SUBROUTINE obs_wri_seaice 570 714 571 SUBROUTINE obs_wri_vel( cprefix, profdata, k2dint )715 SUBROUTINE obs_wri_vel( cprefix, profdata, k2dint, padd, pext ) 572 716 !!----------------------------------------------------------------------- 573 717 !! … … 588 732 589 733 !! * Arguments 590 CHARACTER(LEN=*), INTENT(IN) :: & 591 & cprefix ! Prefix for output files 592 TYPE(obs_prof), INTENT(INOUT) :: & 593 & profdata ! Full set of profile data 594 INTEGER, INTENT(IN) :: & 595 & k2dint ! Horizontal interpolation method 734 CHARACTER(LEN=*), INTENT(IN) :: cprefix ! Prefix for output files 735 TYPE(obs_prof), INTENT(INOUT) :: profdata ! Full set of profile data 736 INTEGER, INTENT(IN) :: k2dint ! Horizontal interpolation method 737 TYPE(obswriinfo), OPTIONAL :: padd ! Additional info for each variable 738 TYPE(obswriinfo), OPTIONAL :: pext ! Extra info 596 739 597 740 !! * Local declarations 598 741 TYPE(obfbdata) :: fbdata 599 CHARACTER(LEN=40) :: &600 & cfname601 INTEGER :: &602 & ilevel603 INTEGER :: &604 & jvar, &605 & jo, &606 & jk, &607 & ik608 REAL(wp) :: &609 &zpres742 CHARACTER(LEN=40) :: cfname 743 INTEGER :: ilevel 744 INTEGER :: jvar 745 INTEGER :: jk 746 INTEGER :: ik 747 INTEGER :: jo 748 INTEGER :: ja 749 INTEGER :: je 750 INTEGER :: nadd 751 INTEGER :: next 752 REAL(wp) :: zpres 610 753 REAL(wp), DIMENSION(:), ALLOCATABLE :: & 611 754 & zu, & 612 755 & zv 756 757 IF ( PRESENT( padd ) ) THEN 758 nadd = padd%inum 759 ELSE 760 nadd = 0 761 ENDIF 762 763 IF ( PRESENT( pext ) ) THEN 764 next = pext%inum 765 ELSE 766 next = 0 767 ENDIF 613 768 614 769 CALL init_obfbdata( fbdata ) … … 618 773 DO jvar = 1, 2 619 774 ilevel = MAX( ilevel, MAXVAL( profdata%var(jvar)%nvlidx(:) ) ) 620 END DO775 END DO 621 776 CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, 2, 0, .TRUE. ) 622 777 … … 627 782 fbdata%cobunit(1) = 'm/s' 628 783 fbdata%cobunit(2) = 'm/s' 784 DO je = 1, next 785 fbdata%cextname(je) = pext%cdname(je) 786 fbdata%cextlong(je) = pext%cdlong(je,1) 787 fbdata%cextunit(je) = pext%cdunit(je,1) 788 END DO 629 789 fbdata%caddname(1) = 'Hx' 630 790 fbdata%caddlong(1,1) = 'Model interpolated zonal velocity' … … 632 792 fbdata%caddunit(1,1) = 'm/s' 633 793 fbdata%caddunit(1,2) = 'm/s' 634 fbdata%caddname(2) = 'HxG RID'794 fbdata%caddname(2) = 'HxG' 635 795 fbdata%caddlong(2,1) = 'Model interpolated zonal velocity (model grid)' 636 796 fbdata%caddlong(2,2) = 'Model interpolated meridional velocity (model grid)' 637 797 fbdata%caddunit(2,1) = 'm/s' 638 fbdata%caddunit(2,2) = 'm/s' 798 fbdata%caddunit(2,2) = 'm/s' 799 fbdata%cgrid(1) = 'U' 800 fbdata%cgrid(2) = 'V' 801 DO ja = 1, nadd 802 fbdata%caddname(2+ja) = padd%cdname(ja) 803 fbdata%caddlong(2+ja,1) = padd%cdlong(ja,1) 804 fbdata%caddunit(2+ja,1) = padd%cdunit(ja,1) 805 END DO 639 806 640 807 WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc … … 683 850 fbdata%iobsj(jo,jvar) = mjg(profdata%mj(jo,jvar)) 684 851 ENDIF 685 END DO852 END DO 686 853 CALL greg2jul( 0, & 687 854 & profdata%nmin(jo), & … … 715 882 ENDIF 716 883 fbdata%iobsk(ik,jo,jvar) = profdata%var(jvar)%mvk(jk) 884 DO ja = 1, nadd 885 fbdata%padd(ik,jo,2+ja,jvar) = & 886 & profdata%var(jvar)%vext(jk,padd%ipoint(ja)) 887 END DO 888 DO je = 1, next 889 fbdata%pext(ik,jo,je) = & 890 & profdata%var(jvar)%vext(jk,pext%ipoint(je)) 891 END DO 717 892 END DO 718 893 END DO -
branches/dev_1784_OBS/NEMO/OPA_SRC/OBS/str_c_to_for.h90
r2001 r2074 20 20 !!--------------------------------------------------------------------- 21 21 !! * Arguments 22 CHARACTER(LEN=*), INTENT(INOUT) :: & 23 & cd_str 22 CHARACTER(LEN=*), INTENT(INOUT) :: cd_str 24 23 25 24 !! * Local declarations
Note: See TracChangeset
for help on using the changeset viewer.