Changeset 5965 for branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90
- Timestamp:
- 2015-12-01T16:35:30+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90
r2287 r5965 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.