Changeset 4990 for trunk/NEMOGCM/NEMO/OPA_SRC/OBS
- Timestamp:
- 2014-12-15T17:42:49+01:00 (9 years ago)
- Location:
- trunk/NEMOGCM/NEMO/OPA_SRC/OBS
- Files:
-
- 10 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/OBS/ddatetoymdhms.h90
r2287 r4990 21 21 22 22 !! * Arguments 23 REAL(dp), INTENT(IN) :: ddate23 real(wp), INTENT(IN) :: ddate 24 24 INTEGER, INTENT(OUT) :: kyea 25 25 INTEGER, INTENT(OUT) :: kmon -
trunk/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
r4741 r4990 208 208 !----------------------------------------------------------------------- 209 209 210 !Initalise all values in namelist arrays211 210 enactfiles(:) = '' 212 211 coriofiles(:) = '' … … 233 232 ln_velfb_av(:) = .FALSE. 234 233 ln_ignmis = .FALSE. 234 235 235 CALL ini_date( dobsini ) 236 236 CALL fin_date( dobsend ) … … 483 483 CALL obs_grid_setup( ) 484 484 IF ( ( n1dint < 0 ).OR.( n1dint > 1 ) ) THEN 485 IF(lwp) WRITE(numout,cform_err) 486 IF(lwp) WRITE(numout,*) ' Choice of vertical (1D) interpolation method', & 487 & ' is not available' 488 nstop = nstop + 1 485 CALL ctl_stop(' Choice of vertical (1D) interpolation method', & 486 & ' is not available') 489 487 ENDIF 490 488 IF ( ( n2dint < 0 ).OR.( n2dint > 4 ) ) THEN 491 IF(lwp) WRITE(numout,cform_err) 492 IF(lwp) WRITE(numout,*) ' Choice of horizontal (2D) interpolation method', & 493 & ' is not available' 494 nstop = nstop + 1 489 CALL ctl_stop(' Choice of horizontal (2D) interpolation method', & 490 & ' is not available') 495 491 ENDIF 496 492 -
trunk/NEMOGCM/NEMO/OPA_SRC/OBS/jul2greg.h90
r2287 r4990 16 16 !! ! 06-05 (A. Vidard) Reformatted and refdate 17 17 !! ! 06-10 (A. Weaver) Cleanup 18 !! ! 2014-09 (D. Lea) Change to use FLOOR to deal with negative prelday 18 19 !!----------------------------------------------------------------------- 19 20 … … 82 83 83 84 zday = prelday 84 ksec = NINT( 86400. * MOD( zday, 1. ) )85 ksec = FLOOR( 86400. * MOD( zday, 1. ) ) 85 86 86 87 IF ( ksec < 0. ) ksec = 86400. + ksec -
trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grid.F90
r2715 r4990 412 412 ENDIF 413 413 414 IF (MAXVAL(ixpos(ipx1:ipx,ipy1:ipy)) == -1) CYCLE! cycle if no lookup points found 414 IF (.NOT. llfourflag) THEN 415 IF (MAXVAL(ixpos(ipx1:ipx,ipy1:ipy)) == -1) CYCLE! cycle if no lookup points found 416 ENDIF 415 417 416 418 jimin = 0 … … 996 998 df = ABS( iypos(ji+1,jj) - iypos(ji,jj) ) 997 999 tmpy1 = df 998 IF ( df < lim xdiff ) numy1 = numy1 + 11000 IF ( df < limydiff ) numy1 = numy1 + 1 999 1001 IF ( df < histsize ) histy1(df+1) = histy1(df+1) + 1 1000 1002 ENDIF … … 1002 1004 df = ABS( iypos(ji,jj+1) - iypos(ji,jj) ) 1003 1005 tmpy2 = df 1004 IF ( df < lim xdiff ) numy2 = numy2+11006 IF ( df < limydiff ) numy2 = numy2+1 1005 1007 IF ( df < histsize ) histy2(df+1) = histy2(df+1)+1 1006 1008 ENDIF -
trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90
r4292 r4990 128 128 & zphi, & 129 129 & zlam 130 REAL(dp), DIMENSION(:), ALLOCATABLE :: &130 real(wp), DIMENSION(:), ALLOCATABLE :: & 131 131 & zdat 132 132 LOGICAL :: llvalprof 133 133 TYPE(obfbdata), POINTER, DIMENSION(:) :: & 134 134 & inpfiles 135 REAL(dp), DIMENSION(knumfiles) :: &135 real(wp), DIMENSION(knumfiles) :: & 136 136 & djulini, & 137 137 & djulend … … 143 143 INTEGER :: is3dt 144 144 INTEGER :: ip3dt 145 INTEGER :: ios 146 INTEGER :: ioserrcount 145 147 INTEGER, DIMENSION(kvars) :: & 146 148 & iv3dt … … 280 282 & krefdate = irefdate(jj) ) 281 283 284 ioserrcount=0 282 285 IF ( ldavtimset ) THEN 283 286 DO ji = 1, inpfiles(jj)%nobs … … 287 290 ! to be the end of the day 288 291 ! 289 READ( inpfiles(jj)%cdtyp(ji), '(I4)' ) itype 292 READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 900 ) itype 293 900 IF ( ios /= 0 ) THEN 294 itype = 0 ! Set type to zero if there is a problem in the string conversion 295 ENDIF 290 296 IF ( ANY (idailyavtypes == itype ) ) THEN 291 297 inpfiles(jj)%ptim(ji) = & … … 468 474 itypsmpp(:) = 0 469 475 470 476 ioserrcount = 0 471 477 DO jk = 1, iproftot 472 478 … … 552 558 553 559 ! Instrument type 554 READ( inpfiles(jj)%cdtyp(ji), '(I4)' ) itype 560 READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 901 ) itype 561 901 IF ( ios /= 0 ) THEN 562 IF (ioserrcount == 0) CALL ctl_warn ( 'Problem converting an instrument type to integer. Setting type to zero' ) 563 ioserrcount = ioserrcount + 1 564 itype = 0 565 ENDIF 566 555 567 profdata%ntyp(iprof) = itype 556 568 -
trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_seaice.F90
r3651 r4990 110 110 & zphi, & 111 111 & zlam 112 REAL(dp), DIMENSION(:), ALLOCATABLE :: &112 real(wp), DIMENSION(:), ALLOCATABLE :: & 113 113 & zdat 114 114 LOGICAL :: llvalprof 115 115 TYPE(obfbdata), POINTER, DIMENSION(:) :: & 116 116 & inpfiles 117 REAL(dp), DIMENSION(knumfiles) :: &117 real(wp), DIMENSION(knumfiles) :: & 118 118 & djulini, & 119 119 & djulend 120 120 INTEGER :: iobs 121 121 INTEGER :: iobstot 122 INTEGER :: ios 123 INTEGER :: ioserrcount 122 124 CHARACTER(len=8) :: cl_refdate 123 125 … … 335 337 ityp (:) = 0 336 338 itypmpp(:) = 0 337 339 340 ioserrcount=0 341 338 342 DO jk = 1, iobstot 339 343 … … 382 386 383 387 ! Instrument type 384 READ( inpfiles(jj)%cdtyp(ji), '(I4)' ) itype 388 READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 901 ) itype 389 901 IF ( ios /= 0 ) THEN 390 IF (ioserrcount == 0) CALL ctl_warn ( 'Problem converting an instrument type to integer. Setting type to zero' ) 391 ioserrcount = ioserrcount + 1 392 itype = 0 393 ENDIF 385 394 seaicedata%ntyp(iobs) = itype 386 395 IF ( itype < iseaicemaxtype + 1 ) THEN -
trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sla.F90
r3651 r4990 111 111 & zphi, & 112 112 & zlam 113 REAL(dp), DIMENSION(:), ALLOCATABLE :: &113 real(wp), DIMENSION(:), ALLOCATABLE :: & 114 114 & zdat 115 115 LOGICAL :: llvalprof … … 117 117 TYPE(obfbdata), POINTER, DIMENSION(:) :: & 118 118 & inpfiles 119 REAL(dp), DIMENSION(knumfiles) :: &119 real(wp), DIMENSION(knumfiles) :: & 120 120 & djulini, & 121 121 & djulend … … 125 125 INTEGER :: iobs 126 126 INTEGER :: iobstot 127 INTEGER :: ios 128 INTEGER :: ioserrcount 127 129 CHARACTER(len=8) :: cl_refdate 128 130 … … 391 393 & iindx ) 392 394 393 CALL obs_surf_alloc( sladata, iobs, kvars, kextr, & 394 & jpi, jpj, kstp ) 395 CALL obs_surf_alloc( sladata, iobs, kvars, kextr, kstp, jpi, jpj ) 395 396 396 397 ! * Read obs/positions, QC, all variable and assign to sladata … … 400 401 ityp (:) = 0 401 402 itypmpp(:) = 0 403 404 ioserrcount = 0 402 405 403 406 DO jk = 1, iobstot … … 451 454 452 455 ! Instrument type 453 READ( inpfiles(jj)%cdtyp(ji), '(I4)' ) itype 456 READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 901 ) itype 457 901 IF ( ios /= 0 ) THEN 458 IF (ioserrcount == 0) CALL ctl_warn ( 'Problem converting an instrument type to integer. Setting type to zero' ) 459 ioserrcount = ioserrcount + 1 460 itype = 0 461 ENDIF 454 462 sladata%ntyp(iobs) = itype 455 463 ityp(itype+1) = ityp(itype+1) + 1 -
trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sst.F90
r3651 r4990 110 110 & zphi, & 111 111 & zlam 112 REAL(dp), DIMENSION(:), ALLOCATABLE :: &112 real(wp), DIMENSION(:), ALLOCATABLE :: & 113 113 & zdat 114 114 LOGICAL :: llvalprof 115 115 TYPE(obfbdata), POINTER, DIMENSION(:) :: & 116 116 & inpfiles 117 REAL(dp), DIMENSION(knumfiles) :: &117 real(wp), DIMENSION(knumfiles) :: & 118 118 & djulini, & 119 119 & djulend 120 120 INTEGER :: iobs 121 121 INTEGER :: iobstot 122 INTEGER :: ios 123 INTEGER :: ioserrcount 122 124 CHARACTER(len=8) :: cl_refdate 123 125 … … 335 337 itypmpp(:) = 0 336 338 339 ioserrcount = 0 340 337 341 DO jk = 1, iobstot 338 342 … … 381 385 382 386 ! Instrument type 383 READ( inpfiles(jj)%cdtyp(ji), '(I4)' ) itype 387 READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 901 ) itype 388 901 IF ( ios /= 0 ) THEN 389 IF (ioserrcount == 0) CALL ctl_warn ( 'Problem converting an instrument type to integer. Setting type to zero' ) 390 ioserrcount = ioserrcount + 1 391 itype = 0 392 ENDIF 384 393 sstdata%ntyp(iobs) = itype 385 394 IF ( itype < isstmaxtype + 1 ) THEN -
trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_vel.F90
r4292 r4990 118 118 & zphi, & 119 119 & zlam 120 REAL(dp), DIMENSION(:), ALLOCATABLE :: &120 real(wp), DIMENSION(:), ALLOCATABLE :: & 121 121 & zdat 122 122 LOGICAL :: & … … 124 124 TYPE(obfbdata), POINTER, DIMENSION(:) :: & 125 125 & inpfiles 126 REAL(dp), DIMENSION(knumfiles) :: &126 real(wp), DIMENSION(knumfiles) :: & 127 127 & djulini, & 128 128 & djulend … … 130 130 INTEGER :: iproftot 131 131 INTEGER :: iuv3dt 132 INTEGER :: ios 133 INTEGER :: ioserrcount 132 134 INTEGER, DIMENSION(kvars) :: iv3dt 133 135 CHARACTER(len=8) :: cl_refdate … … 459 461 460 462 ! Instrument type 461 READ( inpfiles(jj)%cdtyp(ji), '(I4)' ) itype 463 READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 901 ) itype 464 901 IF ( ios /= 0 ) THEN 465 IF (ioserrcount == 0) CALL ctl_warn ( 'Problem converting an instrument type to integer. Setting type to zero' ) 466 ioserrcount = ioserrcount + 1 467 itype = 0 468 ENDIF 462 469 profdata%ntyp(iprof) = itype 463 470 -
trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90
r2287 r4990 6 6 7 7 !!---------------------------------------------------------------------- 8 !! cdf_wri_p3d : Write profile observation diagnostics in NetCDF format8 !! obs_wri_p3d : Write profile observation diagnostics in NetCDF format 9 9 !! obs_wri_sla : Write SLA observation related diagnostics 10 10 !! obs_wri_sst : Write SST observation related diagnostics 11 11 !! obs_wri_seaice: Write seaice observation related diagnostics 12 !! cdf_wri_vel : Write velocity observation diagnostics in NetCDF format 12 !! obs_wri_vel : Write velocity observation diagnostics in NetCDF format 13 !! obs_wri_stats : Print basic statistics on the data being written out 13 14 !!---------------------------------------------------------------------- 14 15 … … 31 32 USE obs_sla_types 32 33 USE obs_rot_vel ! Rotation of velocities 34 USE obs_mpp ! MPP support routines for observation diagnostics 35 USE lib_mpp ! MPP routines 33 36 34 37 IMPLICIT NONE … … 256 259 ! Write the obfbdata structure 257 260 CALL write_obfbdata( cfname, fbdata ) 258 261 262 ! Output some basic statistics 263 CALL obs_wri_stats( fbdata ) 264 259 265 CALL dealloc_obfbdata( fbdata ) 260 266 … … 414 420 CALL write_obfbdata( cfname, fbdata ) 415 421 422 ! Output some basic statistics 423 CALL obs_wri_stats( fbdata ) 424 416 425 CALL dealloc_obfbdata( fbdata ) 417 426 … … 565 574 CALL write_obfbdata( cfname, fbdata ) 566 575 576 ! Output some basic statistics 577 CALL obs_wri_stats( fbdata ) 578 567 579 CALL dealloc_obfbdata( fbdata ) 568 580 … … 715 727 CALL write_obfbdata( cfname, fbdata ) 716 728 729 ! Output some basic statistics 730 CALL obs_wri_stats( fbdata ) 731 717 732 CALL dealloc_obfbdata( fbdata ) 718 733 … … 722 737 !!----------------------------------------------------------------------- 723 738 !! 724 !! *** ROUTINE obs_wri_ p3d***739 !! *** ROUTINE obs_wri_vel *** 725 740 !! 726 741 !! ** Purpose : Write current (profile) observation … … 903 918 CALL write_obfbdata( cfname, fbdata ) 904 919 920 ! Output some basic statistics 921 CALL obs_wri_stats( fbdata ) 922 905 923 CALL dealloc_obfbdata( fbdata ) 906 924 … … 912 930 END SUBROUTINE obs_wri_vel 913 931 932 SUBROUTINE obs_wri_stats( fbdata ) 933 !!----------------------------------------------------------------------- 934 !! 935 !! *** ROUTINE obs_wri_stats *** 936 !! 937 !! ** Purpose : Output some basic statistics of the data being written out 938 !! 939 !! ** Method : 940 !! 941 !! ** Action : 942 !! 943 !! ! 2014-08 (D. Lea) Initial version 944 !!----------------------------------------------------------------------- 945 946 !! * Arguments 947 TYPE(obfbdata) :: fbdata 948 949 !! * Local declarations 950 INTEGER :: jvar 951 INTEGER :: jo 952 INTEGER :: jk 953 954 ! INTEGER :: nlev 955 ! INTEGER :: nlevmpp 956 ! INTEGER :: nobsmpp 957 INTEGER :: numgoodobs 958 INTEGER :: numgoodobsmpp 959 REAL(wp) :: zsumx 960 REAL(wp) :: zsumx2 961 REAL(wp) :: zomb 962 963 IF (lwp) THEN 964 WRITE(numout,*) '' 965 WRITE(numout,*) 'obs_wri_stats :' 966 WRITE(numout,*) '~~~~~~~~~~~~~~~' 967 ENDIF 968 969 DO jvar = 1, fbdata%nvar 970 zsumx=0.0_wp 971 zsumx2=0.0_wp 972 numgoodobs=0 973 DO jo = 1, fbdata%nobs 974 DO jk = 1, fbdata%nlev 975 IF ( ( fbdata%pob(jk,jo,jvar) < 9999.0 ) .AND. & 976 & ( fbdata%pdep(jk,jo) < 9999.0 ) .AND. & 977 & ( fbdata%padd(jk,jo,1,jvar) < 9999.0 ) ) THEN 978 979 zomb=fbdata%pob(jk, jo, jvar)-fbdata%padd(jk, jo, 1, jvar) 980 zsumx=zsumx+zomb 981 zsumx2=zsumx2+zomb**2 982 numgoodobs=numgoodobs+1 983 ENDIF 984 ENDDO 985 ENDDO 986 987 CALL obs_mpp_sum_integer( numgoodobs, numgoodobsmpp ) 988 CALL mpp_sum(zsumx) 989 CALL mpp_sum(zsumx2) 990 991 IF (lwp) THEN 992 WRITE(numout,*) 'Type: ',fbdata%cname(jvar),' Total number of good observations: ',numgoodobsmpp 993 WRITE(numout,*) 'Overall mean obs minus model of the good observations: ',zsumx/numgoodobsmpp 994 WRITE(numout,*) 'Overall RMS obs minus model of the good observations: ',sqrt( zsumx2/numgoodobsmpp ) 995 WRITE(numout,*) '' 996 ENDIF 997 998 ENDDO 999 1000 END SUBROUTINE obs_wri_stats 1001 914 1002 END MODULE obs_write
Note: See TracChangeset
for help on using the changeset viewer.