Changeset 6854
- Timestamp:
- 2016-08-08T12:26:45+02:00 (8 years ago)
- Location:
- branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS
- Files:
-
- 4 edited
- 4 copied
-
diaobs.F90 (modified) (20 diffs)
-
obs_logchl.F90 (copied) (copied from branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_seaice.F90) (3 diffs)
-
obs_logchl_io.F90 (copied) (copied from branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_seaice_io.F90) (3 diffs)
-
obs_oper.F90 (modified) (3 diffs)
-
obs_prep.F90 (modified) (3 diffs)
-
obs_read_logchl.F90 (copied) (copied from branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_seaice.F90) (24 diffs)
-
obs_write.F90 (modified) (3 diffs)
-
obslogchl_io.h90 (copied) (copied from branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obsseaice_io.h90) (13 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
r6406 r6854 21 21 USE par_oce 22 22 USE dom_oce ! Ocean space and time domain variables 23 USE obs_const, ONLY: obfillflt ! Fill value 23 24 USE obs_fbm, ONLY: ln_cl4 ! Class 4 diagnostic switch 24 25 USE obs_read_prof ! Reading and allocation of observations (Coriolis) … … 29 30 USE obs_read_seaice ! Reading and allocation of Sea Ice observations 30 31 USE obs_read_vel ! Reading and allocation of velocity component observations 32 USE obs_read_logchl ! Reading and allocation of logchl observations 31 33 USE obs_prep ! Preparation of obs. (grid search etc). 32 34 USE obs_oper ! Observation operators … … 40 42 USE obs_sst ! SST data storage 41 43 USE obs_seaice ! Sea Ice data storage 44 USE obs_logchl ! logchl data storage 42 45 USE obs_types ! Definitions for observation types 43 46 USE mpp_map ! MPP mapping … … 81 84 LOGICAL, PUBLIC :: ln_velhradcp !: Logical switch for raw high freq netCDF ADCP vel. data 82 85 LOGICAL, PUBLIC :: ln_velfb !: Logical switch for velocities from feedback files 86 LOGICAL, PUBLIC :: ln_logchl !: Logical switch for log10(chlorophyll) 87 LOGICAL, PUBLIC :: ln_logchlfb !: Logical switch for logchl from feedback files 83 88 LOGICAL, PUBLIC :: ln_ssh !: Logical switch for sea surface height 84 89 LOGICAL, PUBLIC :: ln_sss !: Logical switch for sea surface salinity … … 164 169 CHARACTER(len=128) :: velhradcpfiles(MaxNumFiles) 165 170 CHARACTER(len=128) :: velfbfiles(MaxNumFiles) 171 CHARACTER(len=128) :: logchlfiles(MaxNumFiles) 172 CHARACTER(len=128) :: logchlfbfiles(MaxNumFiles) 166 173 CHARACTER(LEN=128) :: reysstname 167 174 CHARACTER(LEN=12) :: reysstfmt … … 188 195 & ln_velhradcp, velhradcpfiles, & 189 196 & ln_velfb, velfbfiles, ln_velfb_av, & 197 & ln_logchl, ln_logchlfb, & 198 & logchlfiles, logchlfbfiles, & 190 199 & ln_profb_enatim, ln_ignmis, ln_cl4, & 191 200 & ln_sstbias, sstbias_files … … 209 218 INTEGER :: jnumvelhradcp 210 219 INTEGER :: jnumvelfb 220 INTEGER :: jnumlogchl 221 INTEGER :: jnumlogchlfb 211 222 INTEGER :: ji 212 223 INTEGER :: jset … … 217 228 ! Read namelist parameters 218 229 !----------------------------------------------------------------------- 230 231 ln_logchl = .FALSE. 232 ln_logchlfb = .FALSE. 219 233 220 234 !Initalise all values in namelist arrays … … 237 251 velcurfiles(:) = '' 238 252 veladcpfiles(:) = '' 253 logchlfiles(:) = '' 254 logchlfbfiles(:) = '' 239 255 sstbias_files(:) = '' 240 256 endailyavtypes(:) = -1 … … 335 351 jnumvelfb = COUNT(lmask) 336 352 lmask(:) = .FALSE. 353 ENDIF 354 IF (ln_logchl) THEN 355 lmask(:) = .FALSE. 356 WHERE (logchlfiles(:) /= '') lmask(:) = .TRUE. 357 jnumlogchl = COUNT(lmask) 358 ENDIF 359 IF (ln_logchlfb) THEN 360 lmask(:) = .FALSE. 361 WHERE (logchlfbfiles(:) /= '') lmask(:) = .TRUE. 362 jnumlogchlfb = COUNT(lmask) 337 363 ENDIF 338 364 … … 366 392 WRITE(numout,*) ' Logical switch for velocity high freq. ADCP ln_velhradcp = ', ln_velhradcp 367 393 WRITE(numout,*) ' Logical switch for feedback velocity data ln_velfb = ', ln_velfb 394 WRITE(numout,*) ' Logical switch for logchl observations ln_logchl = ', ln_logchl 395 WRITE(numout,*) ' Logical switch for feedback logchl data ln_logchlfb = ', ln_logchlfb 368 396 WRITE(numout,*) ' Global distribtion of observations ln_grid_global = ',ln_grid_global 369 397 WRITE(numout,*) & … … 462 490 TRIM(velfbfiles(ji)) 463 491 ENDIF 492 END DO 493 ENDIF 494 IF (ln_logchl) THEN 495 DO ji = 1, jnumlogchl 496 WRITE(numout,'(1X,2A)') ' logchl input observation file name logchlfiles = ', & 497 TRIM(logchlfiles(ji)) 498 END DO 499 ENDIF 500 IF (ln_logchlfb) THEN 501 DO ji = 1, jnumlogchlfb 502 WRITE(numout,'(1X,2A)') ' Feedback logchl input observation file name logchlfbfiles = ', & 503 TRIM(logchlfbfiles(ji)) 464 504 END DO 465 505 ENDIF … … 498 538 & ( .NOT. ln_vel3d ).AND. & 499 539 & ( .NOT. ln_ssh ).AND.( .NOT. ln_sst ).AND.( .NOT. ln_sss ).AND. & 500 & ( .NOT. ln_seaice ).AND.( .NOT. ln_vel3d ) ) THEN540 & ( .NOT. ln_seaice ).AND.( .NOT. ln_vel3d ).AND.( .NOT. ln_logchl ) ) THEN 501 541 IF(lwp) WRITE(numout,cform_war) 502 542 IF(lwp) WRITE(numout,*) ' key_diaobs is activated but logical flags', & 503 & ' ln_t3d, ln_s3d, ln_sla, ln_ssh, ln_sst, ln_sss, ln_seaice, ln_vel3d are all set to .FALSE.' 543 & ' ln_t3d, ln_s3d, ln_sla, ln_ssh, ln_sst, ln_sss, ln_seaice, ln_vel3d,', & 544 & ' ln_logchl are all set to .FALSE.' 504 545 nwarn = nwarn + 1 505 546 ENDIF … … 999 1040 1000 1041 ENDIF 1042 1043 ! - log10(chlorophyll) 1044 1045 IF ( ln_logchl ) THEN 1046 1047 ! Set the number of variables for logchl to 1 1048 nlogchlvars = 1 1049 1050 ! Set the number of extra variables for logchl to 0 1051 nlogchlextr = 0 1052 1053 IF ( ln_logchlfb ) THEN 1054 nlogchlsets = jnumlogchlfb 1055 ELSE 1056 nlogchlsets = 1 1057 ENDIF 1058 1059 ALLOCATE(logchldata(nlogchlsets)) 1060 ALLOCATE(logchldatqc(nlogchlsets)) 1061 logchldata(:)%nsurf=0 1062 logchldatqc(:)%nsurf=0 1063 1064 nlogchlsets = 0 1065 1066 IF ( ln_logchlfb ) THEN ! Feedback file format 1067 1068 DO jset = 1, jnumlogchlfb 1069 1070 nlogchlsets = nlogchlsets + 1 1071 1072 CALL obs_rea_logchl( 0, logchldata(nlogchlsets), 1, & 1073 & logchlfbfiles(jset:jset), & 1074 & nlogchlvars, nlogchlextr, nitend-nit000+2, & 1075 & dobsini, dobsend, ln_ignmis, .FALSE. ) 1076 1077 CALL obs_pre_logchl( logchldata(nlogchlsets), logchldatqc(nlogchlsets), & 1078 & ln_logchl, ln_nea ) 1079 1080 ENDDO 1081 1082 ELSE ! Original file format 1083 1084 nlogchlsets = nlogchlsets + 1 1085 1086 CALL obs_rea_logchl( 1, logchldata(nlogchlsets), jnumlogchl, & 1087 & logchlfiles(1:jnumlogchl), & 1088 & nlogchlvars, nlogchlextr, nitend-nit000+2, & 1089 & dobsini, dobsend, ln_ignmis, .FALSE. ) 1090 1091 CALL obs_pre_logchl( logchldata(nlogchlsets), logchldatqc(nlogchlsets), & 1092 & ln_logchl, ln_nea ) 1093 1094 ENDIF 1095 1096 ENDIF 1001 1097 1002 1098 END SUBROUTINE dia_obs_init … … 1016 1112 !! - Sea surface salinity 1017 1113 !! - Velocity component (U,V) profiles 1114 !! - Sea surface log10(chlorophyll) 1018 1115 !! 1019 1116 !! ** Action : … … 1053 1150 & frld 1054 1151 #endif 1152 #if defined key_hadocc 1153 USE trc, ONLY : & ! HadOCC chlorophyll 1154 & HADOCC_CHL, & 1155 & HADOCC_FILL_FLT 1156 #elif defined key_medusa && defined key_foam_medusa 1157 USE trc, ONLY : & ! MEDUSA chlorophyll 1158 & MEDUSA_CHL, & 1159 & MEDUSA_FILL_FLT 1160 #elif defined key_fabm 1161 !USE ??? ! ERSEM chlorophyll 1162 #endif 1055 1163 IMPLICIT NONE 1056 1164 … … 1064 1172 INTEGER :: jseaiceset ! sea ice data set loop variable 1065 1173 INTEGER :: jveloset ! velocity profile data loop variable 1174 INTEGER :: jlogchlset ! logchl data set loop variable 1066 1175 INTEGER :: jvar ! Variable number 1067 1176 #if ! defined key_lim2 && ! defined key_lim3 1068 1177 REAL(wp), POINTER, DIMENSION(:,:) :: frld 1069 1178 #endif 1179 REAL(wp) :: tiny ! small number 1180 REAL(wp), DIMENSION(jpi,jpj) :: & 1181 logchl ! array for log chlorophyll 1182 REAL(wp), DIMENSION(jpi,jpj) :: & 1183 maskchl ! array for special chlorophyll mask 1070 1184 CHARACTER(LEN=20) :: datestr=" ",timestr=" " 1071 1185 … … 1177 1291 ENDIF 1178 1292 1293 IF ( ln_logchl ) THEN 1294 1295 #if defined key_hadocc 1296 logchl(:,:) = HADOCC_CHL(:,:,1) ! (not log) chlorophyll from HadOCC 1297 #elif defined key_medusa && defined key_foam_medusa 1298 logchl(:,:) = MEDUSA_CHL(:,:,1) ! (not log) chlorophyll from HadOCC 1299 #elif defined key_fabm 1300 !logchl(:,:) = ??? ! (not log) chlorophyll from ERSEM 1301 CALL ctl_stop( ' Trying to run logchl observation operator', & 1302 & ' but not properly implemented for FABM-ERSEM yet' ) 1303 #else 1304 CALL ctl_stop( ' Trying to run logchl observation operator', & 1305 & ' but no biogeochemical model appears to have been defined' ) 1306 #endif 1307 1308 maskchl(:,:) = tmask(:,:,1) ! create a special mask to exclude certain things 1309 1310 ! Take the log10 where we can, otherwise exclude 1311 tiny = 1.0e-20 1312 WHERE(logchl(:,:) > tiny .AND. logchl(:,:) /= obfillflt ) 1313 logchl(:,:) = LOG10(logchl(:,:)) 1314 ELSEWHERE 1315 logchl(:,:) = obfillflt 1316 maskchl(:,:) = 0 1317 END WHERE 1318 1319 DO jlogchlset = 1, nlogchlsets 1320 CALL obs_logchl_opt( logchldatqc(jlogchlset), & 1321 & kstp, jpi, jpj, nit000, logchl(:,:), & 1322 & maskchl(:,:), n2dint ) 1323 END DO 1324 ENDIF 1325 1179 1326 #if ! defined key_lim2 && ! defined key_lim3 1180 1327 CALL wrk_dealloc(jpi,jpj,frld) … … 1209 1356 INTEGER :: jsstset ! SST data set loop variable 1210 1357 INTEGER :: jseaiceset ! Sea Ice data set loop variable 1358 INTEGER :: jlogchlset ! logchl data set loop variable 1211 1359 INTEGER :: jset 1212 1360 INTEGER :: jfbini … … 1453 1601 ENDIF 1454 1602 1603 ENDIF 1604 1605 ! - log10(chlorophyll) 1606 IF ( ln_logchl ) THEN 1607 1608 ! Copy data from logchldatqc to logchldata structures 1609 DO jlogchlset = 1, nlogchlsets 1610 1611 CALL obs_surf_decompress( logchldatqc(jlogchlset), & 1612 & logchldata(jlogchlset), .TRUE., numout ) 1613 1614 END DO 1615 1616 ! Mark as bad observations with no valid model counterpart due to activities in dia_obs 1617 ! Seem to need to set to fill value rather than marking as bad to be effective, so do both 1618 DO jlogchlset = 1, nlogchlsets 1619 WHERE ( logchldata(jlogchlset)%rmod(:,1) == obfillflt ) 1620 logchldata(jlogchlset)%nqc(:) = 1 1621 logchldata(jlogchlset)%robs(:,1) = obfillflt 1622 END WHERE 1623 END DO 1624 1625 ! Write the logchl data 1626 DO jlogchlset = 1, nlogchlsets 1627 1628 WRITE(cdtmp,'(A,I2.2)')'logchlfb_',jlogchlset 1629 CALL obs_wri_logchl( cdtmp, logchldata(jlogchlset) ) 1630 1631 END DO 1632 1455 1633 ENDIF 1456 1634 -
branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_logchl.F90
r6845 r6854 1 MODULE obs_ seaice1 MODULE obs_logchl 2 2 !!===================================================================== 3 !! *** MODULE obs_ seaice***4 !! Observation diagnostics: Storage space for sea iceobservations3 !! *** MODULE obs_logchl *** 4 !! Observation diagnostics: Storage space for logchl observations 5 5 !! arrays and additional flags etc. 6 6 !!===================================================================== … … 13 13 14 14 !! * Modules used 15 USE obs_surf_def ! Definition of s ea ice data types and tools15 USE obs_surf_def ! Definition of surface data types and tools 16 16 17 17 IMPLICIT NONE … … 22 22 PRIVATE 23 23 24 PUBLIC n seaicevars, nseaiceextr, nseaicesets, seaicedata, seaicedatqc24 PUBLIC nlogchlvars, nlogchlextr, nlogchlsets, logchldata, logchldatqc 25 25 26 26 !! * Shared Module variables 27 INTEGER :: n seaicevars ! Number of seaicedata variables28 INTEGER :: n seaiceextr ! Number of seaicedata extra29 ! variables30 INTEGER :: n seaicesets ! Number of seaicedata sets31 TYPE(obs_surf), POINTER, DIMENSION(:) :: seaicedata ! Initial sea icedata32 TYPE(obs_surf), POINTER, DIMENSION(:) :: seaicedatqc ! Sea ice data after quality control27 INTEGER :: nlogchlvars ! Number of logchldata variables 28 INTEGER :: nlogchlextr ! Number of logchldata extra 29 ! variables 30 INTEGER :: nlogchlsets ! Number of logchldata sets 31 TYPE(obs_surf), POINTER, DIMENSION(:) :: logchldata ! Initial logchl data 32 TYPE(obs_surf), POINTER, DIMENSION(:) :: logchldatqc ! Sea ice data after quality control 33 33 34 END MODULE obs_ seaice34 END MODULE obs_logchl 35 35 -
branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_logchl_io.F90
r6845 r6854 1 MODULE obs_ seaice_io1 MODULE obs_logchl_io 2 2 !!====================================================================== 3 !! *** MODULE obs_ seaice_io ***4 !! Observation operators : I/O for GHRSEAICEfiles3 !! *** MODULE obs_logchl_io *** 4 !! Observation operators : I/O for logchl files 5 5 !!====================================================================== 6 6 !! History : … … 8 8 !!---------------------------------------------------------------------- 9 9 !!---------------------------------------------------------------------- 10 !! read_ seaicefile : Read a obfbdata structure from an GHRSEAICEfile10 !! read_logchlfile : Read a obfbdata structure from a logchl file 11 11 !!---------------------------------------------------------------------- 12 12 USE par_kind … … 26 26 CONTAINS 27 27 28 #include "obs seaice_io.h90"28 #include "obslogchl_io.h90" 29 29 30 END MODULE obs_ seaice_io30 END MODULE obs_logchl_io -
branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90
r6301 r6854 23 23 !! obs_vel_opt : Compute the model counterpart of zonal and meridional 24 24 !! components of velocity from observations. 25 !! obs_logchl_opt : Compute the model counterpart of log10(chlorophyll) 26 !! observations 25 27 !!---------------------------------------------------------------------- 26 28 … … 63 65 & obs_sss_opt, & ! Compute the model counterpart of SSS observations 64 66 & obs_seaice_opt, & 65 & obs_vel_opt ! Compute the model counterpart of velocity profile data 67 & obs_vel_opt, & ! Compute the model counterpart of velocity profile data 68 & obs_logchl_opt ! Compute the model counterpart of logchl data 66 69 67 70 INTEGER, PARAMETER, PUBLIC :: imaxavtypes = 20 ! Max number of daily avgd obs types … … 2052 2055 END SUBROUTINE obs_vel_opt 2053 2056 2057 SUBROUTINE obs_logchl_opt( logchldatqc, kt, kpi, kpj, kit000, & 2058 & plogchln, plogchlmask, k2dint ) 2059 2060 !!----------------------------------------------------------------------- 2061 !! 2062 !! *** ROUTINE obs_logchl_opt *** 2063 !! 2064 !! ** Purpose : Compute the model counterpart of logchl 2065 !! data by interpolating from the model grid to the 2066 !! observation point. 2067 !! 2068 !! ** Method : Linearly interpolate to each observation point using 2069 !! the model values at the corners of the surrounding grid box. 2070 !! 2071 !! The now model logchl is first computed at the obs (lon, lat) point. 2072 !! 2073 !! Several horizontal interpolation schemes are available: 2074 !! - distance-weighted (great circle) (k2dint = 0) 2075 !! - distance-weighted (small angle) (k2dint = 1) 2076 !! - bilinear (geographical grid) (k2dint = 2) 2077 !! - bilinear (quadrilateral grid) (k2dint = 3) 2078 !! - polynomial (quadrilateral grid) (k2dint = 4) 2079 !! 2080 !! 2081 !! ** Action : 2082 !! 2083 !! History : 2084 !! 2085 !!----------------------------------------------------------------------- 2086 2087 !! * Modules used 2088 USE obs_surf_def ! Definition of storage space for surface observations 2089 2090 IMPLICIT NONE 2091 2092 !! * Arguments 2093 TYPE(obs_surf), INTENT(INOUT) :: logchldatqc ! Subset of surface data not failing screening 2094 INTEGER, INTENT(IN) :: kt ! Time step 2095 INTEGER, INTENT(IN) :: kpi ! Model grid parameters 2096 INTEGER, INTENT(IN) :: kpj 2097 INTEGER, INTENT(IN) :: kit000 ! Number of the first time step 2098 ! (kit000-1 = restart time) 2099 INTEGER, INTENT(IN) :: k2dint ! Horizontal interpolation type (see header) 2100 REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 2101 & plogchln, & ! Model logchl field 2102 & plogchlmask ! Land-sea mask 2103 2104 !! * Local declarations 2105 INTEGER :: ji 2106 INTEGER :: jj 2107 INTEGER :: jobs 2108 INTEGER :: inrc 2109 INTEGER :: ilogchl 2110 INTEGER :: iobs 2111 2112 REAL(KIND=wp) :: zlam 2113 REAL(KIND=wp) :: zphi 2114 REAL(KIND=wp) :: zext(1), zobsmask(1) 2115 REAL(kind=wp), DIMENSION(2,2,1) :: & 2116 & zweig 2117 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 2118 & zmask, & 2119 & zlogchll, & 2120 & zglam, & 2121 & zgphi 2122 INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 2123 & igrdi, & 2124 & igrdj 2125 2126 !------------------------------------------------------------------------ 2127 ! Local initialization 2128 !------------------------------------------------------------------------ 2129 ! ... Record and data counters 2130 inrc = kt - kit000 + 2 2131 ilogchl = logchldatqc%nsstp(inrc) 2132 2133 ! Get the data for interpolation 2134 2135 ALLOCATE( & 2136 & igrdi(2,2,ilogchl), & 2137 & igrdj(2,2,ilogchl), & 2138 & zglam(2,2,ilogchl), & 2139 & zgphi(2,2,ilogchl), & 2140 & zmask(2,2,ilogchl), & 2141 & zlogchll(2,2,ilogchl) & 2142 & ) 2143 2144 DO jobs = logchldatqc%nsurfup + 1, logchldatqc%nsurfup + ilogchl 2145 iobs = jobs - logchldatqc%nsurfup 2146 igrdi(1,1,iobs) = logchldatqc%mi(jobs)-1 2147 igrdj(1,1,iobs) = logchldatqc%mj(jobs)-1 2148 igrdi(1,2,iobs) = logchldatqc%mi(jobs)-1 2149 igrdj(1,2,iobs) = logchldatqc%mj(jobs) 2150 igrdi(2,1,iobs) = logchldatqc%mi(jobs) 2151 igrdj(2,1,iobs) = logchldatqc%mj(jobs)-1 2152 igrdi(2,2,iobs) = logchldatqc%mi(jobs) 2153 igrdj(2,2,iobs) = logchldatqc%mj(jobs) 2154 END DO 2155 2156 CALL obs_int_comm_2d( 2, 2, ilogchl, & 2157 & igrdi, igrdj, glamt, zglam ) 2158 CALL obs_int_comm_2d( 2, 2, ilogchl, & 2159 & igrdi, igrdj, gphit, zgphi ) 2160 CALL obs_int_comm_2d( 2, 2, ilogchl, & 2161 & igrdi, igrdj, plogchlmask, zmask ) 2162 CALL obs_int_comm_2d( 2, 2, ilogchl, & 2163 & igrdi, igrdj, plogchln, zlogchll ) 2164 2165 DO jobs = logchldatqc%nsurfup + 1, logchldatqc%nsurfup + ilogchl 2166 2167 iobs = jobs - logchldatqc%nsurfup 2168 2169 IF ( kt /= logchldatqc%mstp(jobs) ) THEN 2170 2171 IF(lwp) THEN 2172 WRITE(numout,*) 2173 WRITE(numout,*) ' E R R O R : Observation', & 2174 & ' time step is not consistent with the', & 2175 & ' model time step' 2176 WRITE(numout,*) ' =========' 2177 WRITE(numout,*) 2178 WRITE(numout,*) ' Record = ', jobs, & 2179 & ' kt = ', kt, & 2180 & ' mstp = ', logchldatqc%mstp(jobs), & 2181 & ' ntyp = ', logchldatqc%ntyp(jobs) 2182 ENDIF 2183 CALL ctl_stop( 'obs_logchl_opt', 'Inconsistent time' ) 2184 2185 ENDIF 2186 2187 zlam = logchldatqc%rlam(jobs) 2188 zphi = logchldatqc%rphi(jobs) 2189 2190 ! Get weights to interpolate the model logchl to the observation point 2191 CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi, & 2192 & zglam(:,:,iobs), zgphi(:,:,iobs), & 2193 & zmask(:,:,iobs), zweig, zobsmask ) 2194 2195 ! ... Interpolate the model logchl to the observation point 2196 CALL obs_int_h2d( 1, 1, & 2197 & zweig, zlogchll(:,:,iobs), zext ) 2198 2199 logchldatqc%rmod(jobs,1) = zext(1) 2200 2201 END DO 2202 2203 ! Deallocate the data for interpolation 2204 DEALLOCATE( & 2205 & igrdi, & 2206 & igrdj, & 2207 & zglam, & 2208 & zgphi, & 2209 & zmask, & 2210 & zlogchll & 2211 & ) 2212 2213 logchldatqc%nsurfup = logchldatqc%nsurfup + ilogchl 2214 2215 END SUBROUTINE obs_logchl_opt 2216 2054 2217 END MODULE obs_oper 2055 2218 -
branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90
r6301 r6854 12 12 !! obs_pre_seaice : First level check and screening of sea ice observations 13 13 !! obs_pre_vel : First level check and screening of velocity obs. 14 !! obs_pre_logchl : First level check and screening of logchl obs. 14 15 !! obs_scr : Basic screening of the observations 15 16 !! obs_coo_tim : Compute number of time steps to the observation time … … 41 42 & obs_pre_seaice, & ! First level check and screening of sea ice data 42 43 & obs_pre_vel, & ! First level check and screening of velocity profiles 44 & obs_pre_logchl, & ! First level check and screening of logchl data 43 45 & calc_month_len ! Calculate the number of days in the months of a year 44 46 … … 1186 1188 END SUBROUTINE obs_pre_vel 1187 1189 1190 SUBROUTINE obs_pre_logchl( logchldata, logchldatqc, ld_logchl, ld_nea ) 1191 !!---------------------------------------------------------------------- 1192 !! *** ROUTINE obs_pre_logchl *** 1193 !! 1194 !! ** Purpose : First level check and screening of logchl observations 1195 !! 1196 !! ** Method : First level check and screening of logchl observations 1197 !! 1198 !! ** Action : 1199 !! 1200 !! References : 1201 !! 1202 !! History : 1203 !!---------------------------------------------------------------------- 1204 !! * Modules used 1205 USE domstp ! Domain: set the time-step 1206 USE par_oce ! Ocean parameters 1207 USE dom_oce, ONLY : & ! Geographical information 1208 & glamt, & 1209 & gphit, & 1210 & tmask 1211 !! * Arguments 1212 TYPE(obs_surf), INTENT(INOUT) :: logchldata ! Full set of logchl data 1213 TYPE(obs_surf), INTENT(INOUT) :: logchldatqc ! Subset of logchl data not failing screening 1214 LOGICAL :: ld_logchl ! Switch for logchl data 1215 LOGICAL :: ld_nea ! Switch for rejecting observation near land 1216 !! * Local declarations 1217 INTEGER :: iyea0 ! Initial date 1218 INTEGER :: imon0 ! - (year, month, day, hour, minute) 1219 INTEGER :: iday0 1220 INTEGER :: ihou0 1221 INTEGER :: imin0 1222 INTEGER :: icycle ! Current assimilation cycle 1223 ! Counters for observations that 1224 INTEGER :: iotdobs ! - outside time domain 1225 INTEGER :: iosdsobs ! - outside space domain 1226 INTEGER :: ilansobs ! - within a model land cell 1227 INTEGER :: inlasobs ! - close to land 1228 INTEGER :: igrdobs ! - fail the grid search 1229 ! Global counters for observations that 1230 INTEGER :: iotdobsmpp ! - outside time domain 1231 INTEGER :: iosdsobsmpp ! - outside space domain 1232 INTEGER :: ilansobsmpp ! - within a model land cell 1233 INTEGER :: inlasobsmpp ! - close to land 1234 INTEGER :: igrdobsmpp ! - fail the grid search 1235 LOGICAL, DIMENSION(:), ALLOCATABLE :: & 1236 & llvalid ! data selection 1237 INTEGER :: jobs ! Obs. loop variable 1238 INTEGER :: jstp ! Time loop variable 1239 INTEGER :: inrc ! Time index variable 1240 1241 IF (lwp) WRITE(numout,*)'obs_pre_logchl : Preparing the logchl observations...' 1242 1243 ! Initial date initialization (year, month, day, hour, minute) 1244 iyea0 = ndate0 / 10000 1245 imon0 = ( ndate0 - iyea0 * 10000 ) / 100 1246 iday0 = ndate0 - iyea0 * 10000 - imon0 * 100 1247 ihou0 = 0 1248 imin0 = 0 1249 1250 icycle = no ! Assimilation cycle 1251 1252 ! Diagnostics counters for various failures. 1253 1254 iotdobs = 0 1255 igrdobs = 0 1256 iosdsobs = 0 1257 ilansobs = 0 1258 inlasobs = 0 1259 1260 ! ----------------------------------------------------------------------- 1261 ! Find time coordinate for logchl data 1262 ! ----------------------------------------------------------------------- 1263 1264 CALL obs_coo_tim( icycle, & 1265 & iyea0, imon0, iday0, ihou0, imin0, & 1266 & logchldata%nsurf, logchldata%nyea, logchldata%nmon, & 1267 & logchldata%nday, logchldata%nhou, logchldata%nmin, & 1268 & logchldata%nqc, logchldata%mstp, iotdobs ) 1269 CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp ) 1270 ! ----------------------------------------------------------------------- 1271 ! Check for logchl data failing the grid search 1272 ! ----------------------------------------------------------------------- 1273 1274 CALL obs_coo_grd( logchldata%nsurf, logchldata%mi, logchldata%mj, & 1275 & logchldata%nqc, igrdobs ) 1276 CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp ) 1277 1278 ! ----------------------------------------------------------------------- 1279 ! Check for land points. 1280 ! ----------------------------------------------------------------------- 1281 1282 CALL obs_coo_spc_2d( logchldata%nsurf, & 1283 & jpi, jpj, & 1284 & logchldata%mi, logchldata%mj, & 1285 & logchldata%rlam, logchldata%rphi, & 1286 & glamt, gphit, & 1287 & tmask(:,:,1), logchldata%nqc, & 1288 & iosdsobs, ilansobs, & 1289 & inlasobs, ld_nea ) 1290 1291 CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 1292 CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 1293 CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 1294 1295 ! ----------------------------------------------------------------------- 1296 ! Copy useful data from the logchldata data structure to 1297 ! the logchldatqc data structure 1298 ! ----------------------------------------------------------------------- 1299 1300 ! Allocate the selection arrays 1301 1302 ALLOCATE( llvalid(logchldata%nsurf) ) 1303 1304 ! We want all data which has qc flags <= 0 1305 1306 llvalid(:) = ( logchldata%nqc(:) <= 10 ) 1307 1308 ! The actual copying 1309 1310 CALL obs_surf_compress( logchldata, logchldatqc, .TRUE., numout, & 1311 & lvalid=llvalid ) 1312 1313 ! Dellocate the selection arrays 1314 DEALLOCATE( llvalid ) 1315 1316 ! ----------------------------------------------------------------------- 1317 ! Print information about what observations are left after qc 1318 ! ----------------------------------------------------------------------- 1319 1320 ! Update the total observation counter array 1321 1322 IF(lwp) THEN 1323 WRITE(numout,*) 1324 WRITE(numout,*) 'obs_pre_logchl :' 1325 WRITE(numout,*) '~~~~~~~~~~~' 1326 WRITE(numout,*) 1327 WRITE(numout,*) ' logchl data outside time domain = ', & 1328 & iotdobsmpp 1329 WRITE(numout,*) ' Remaining logchl data that failed grid search = ', & 1330 & igrdobsmpp 1331 WRITE(numout,*) ' Remaining logchl data outside space domain = ', & 1332 & iosdsobsmpp 1333 WRITE(numout,*) ' Remaining logchl data at land points = ', & 1334 & ilansobsmpp 1335 IF (ld_nea) THEN 1336 WRITE(numout,*) ' Remaining logchl data near land points (removed) = ', & 1337 & inlasobsmpp 1338 ELSE 1339 WRITE(numout,*) ' Remaining logchl data near land points (kept) = ', & 1340 & inlasobsmpp 1341 ENDIF 1342 WRITE(numout,*) ' logchl data accepted = ', & 1343 & logchldatqc%nsurfmpp 1344 1345 WRITE(numout,*) 1346 WRITE(numout,*) ' Number of observations per time step :' 1347 WRITE(numout,*) 1348 WRITE(numout,1997) 1349 WRITE(numout,1998) 1350 ENDIF 1351 1352 DO jobs = 1, logchldatqc%nsurf 1353 inrc = logchldatqc%mstp(jobs) + 2 - nit000 1354 logchldatqc%nsstp(inrc) = logchldatqc%nsstp(inrc) + 1 1355 END DO 1356 1357 CALL obs_mpp_sum_integers( logchldatqc%nsstp, logchldatqc%nsstpmpp, & 1358 & nitend - nit000 + 2 ) 1359 1360 IF ( lwp ) THEN 1361 DO jstp = nit000 - 1, nitend 1362 inrc = jstp - nit000 + 2 1363 WRITE(numout,1999) jstp, logchldatqc%nsstpmpp(inrc) 1364 END DO 1365 ENDIF 1366 1367 1997 FORMAT(10X,'Time step',5X,'logchl data') 1368 1998 FORMAT(10X,'---------',5X,'------------') 1369 1999 FORMAT(10X,I9,5X,I17) 1370 1371 END SUBROUTINE obs_pre_logchl 1372 1188 1373 SUBROUTINE obs_coo_tim( kcycle, & 1189 1374 & kyea0, kmon0, kday0, khou0, kmin0, & -
branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_logchl.F90
r6845 r6854 1 MODULE obs_read_ seaice1 MODULE obs_read_logchl 2 2 !!====================================================================== 3 !! *** MODULE obs_read_ seaice***4 !! Observation diagnostics: Read the along track SEAICEdata from5 !! GHRSST or any SEAICEdata from feedback files3 !! *** MODULE obs_read_logchl *** 4 !! Observation diagnostics: Read the along track logchl data from 5 !! GHRSST or any logchl data from feedback files 6 6 !!====================================================================== 7 7 8 8 !!---------------------------------------------------------------------- 9 !! obs_rea_ seaice : Driver for reading seaice data from the GHRSST/feedback9 !! obs_rea_logchl : Driver for reading logchl data from the feedback 10 10 !!---------------------------------------------------------------------- 11 11 … … 21 21 USE obs_surf_def ! Surface observation definitions 22 22 USE obs_types ! Observation type definitions 23 USE obs_ seaice_io ! I/O for seaicefiles24 USE iom ! I/O of fields for Reynolds data23 USE obs_logchl_io ! I/O for logchl files 24 USE iom ! I/O 25 25 USE netcdf ! NetCDF library 26 26 … … 30 30 PRIVATE 31 31 32 PUBLIC obs_rea_ seaice ! Read the seaiceobservations from the point data32 PUBLIC obs_rea_logchl ! Read the logchl observations from the point data 33 33 34 34 !!---------------------------------------------------------------------- … … 40 40 CONTAINS 41 41 42 SUBROUTINE obs_rea_ seaice( kformat, &43 & seaicedata, knumfiles, cfilenames, &42 SUBROUTINE obs_rea_logchl( kformat, & 43 & logchldata, knumfiles, cfilenames, & 44 44 & kvars, kextr, kstp, ddobsini, ddobsend, & 45 45 & ldignmis, ldmod ) 46 46 !!--------------------------------------------------------------------- 47 47 !! 48 !! *** ROUTINE obs_rea_ seaice***49 !! 50 !! ** Purpose : Read from file the seaicedata51 !! 52 !! ** Method : Depending on kformat either AVISO or48 !! *** ROUTINE obs_rea_logchl *** 49 !! 50 !! ** Purpose : Read from file the logchl data 51 !! 52 !! ** Method : Depending on kformat either old or new style 53 53 !! feedback data files are read 54 54 !! … … 63 63 !! * Arguments 64 64 INTEGER :: kformat ! Format of input data 65 ! ! 0: Feedback66 ! ! 1: GHRSST65 ! ! 0: New-style feedback 66 ! ! 1: Old-style feedback 67 67 TYPE(obs_surf), INTENT(INOUT) :: & 68 & seaicedata ! seaicedata to be read68 & logchldata ! logchl data to be read 69 69 INTEGER, INTENT(IN) :: knumfiles ! Number of corio format files to read in 70 70 CHARACTER(LEN=128), INTENT(IN) :: cfilenames(knumfiles) ! File names to read in 71 INTEGER, INTENT(IN) :: kvars ! Number of variables in seaicedata72 INTEGER, INTENT(IN) :: kextr ! Number of extra fields for each var in seaicedata71 INTEGER, INTENT(IN) :: kvars ! Number of variables in logchldata 72 INTEGER, INTENT(IN) :: kextr ! Number of extra fields for each var in logchldata 73 73 INTEGER, INTENT(IN) :: kstp ! Ocean time-step index 74 74 LOGICAL, INTENT(IN) :: ldignmis ! Ignore missing files … … 78 78 79 79 !! * Local declarations 80 CHARACTER(LEN=14), PARAMETER :: cpname='obs_rea_ seaice'80 CHARACTER(LEN=14), PARAMETER :: cpname='obs_rea_logchl' 81 81 INTEGER :: ji 82 82 INTEGER :: jj … … 95 95 & irefdate 96 96 INTEGER :: iobsmpp 97 INTEGER, PARAMETER :: i seaicemaxtype = 102498 INTEGER, DIMENSION(0:i seaicemaxtype) :: &97 INTEGER, PARAMETER :: ilogchlmaxtype = 1024 98 INTEGER, DIMENSION(0:ilogchlmaxtype) :: & 99 99 & ityp, & 100 100 & itypmpp … … 105 105 & iindx, & 106 106 & ifileidx, & 107 & i seaiceidx107 & ilogchlidx 108 108 INTEGER :: itype 109 109 REAL(wp), DIMENSION(:), ALLOCATABLE :: & … … 143 143 ALLOCATE( inpfiles(inobf) ) 144 144 145 seaice_files : DO jj = 1, inobf145 logchl_files : DO jj = 1, inobf 146 146 147 147 !--------------------------------------------------------------------- … … 150 150 IF(lwp) THEN 151 151 WRITE(numout,*) 152 WRITE(numout,*) ' obs_rea_ seaice: Reading from file = ', &152 WRITE(numout,*) ' obs_rea_logchl : Reading from file = ', & 153 153 & TRIM( TRIM( cfilenames(jj) ) ) 154 154 WRITE(numout,*) ' ~~~~~~~~~~~~~~' … … 177 177 178 178 !------------------------------------------------------------------ 179 ! Close the file since it is opened in read_proffile179 ! Close the file since it is opened elsewhere 180 180 !------------------------------------------------------------------ 181 181 … … 183 183 184 184 !------------------------------------------------------------------ 185 ! Read the profilefile into inpfiles185 ! Read the file into inpfiles 186 186 !------------------------------------------------------------------ 187 187 IF ( kformat == 0 ) THEN … … 200 200 ENDIF 201 201 ELSEIF ( kformat == 1) THEN 202 CALL read_ seaice( TRIM( cfilenames(jj) ), inpfiles(jj), &202 CALL read_logchl( TRIM( cfilenames(jj) ), inpfiles(jj), & 203 203 & numout, lwp, .TRUE. ) 204 204 ELSE … … 291 291 ENDIF 292 292 293 END DO seaice_files293 END DO logchl_files 294 294 295 295 !----------------------------------------------------------------------- … … 298 298 299 299 !--------------------------------------------------------------------- 300 ! Loop over input data files to count total number of profiles300 ! Loop over input data files to count total number of obs 301 301 !--------------------------------------------------------------------- 302 302 iobstot = 0 … … 311 311 312 312 ALLOCATE( iindx(iobstot), ifileidx(iobstot), & 313 & i seaiceidx(iobstot), zdat(iobstot) )313 & ilogchlidx(iobstot), zdat(iobstot) ) 314 314 jk = 0 315 315 DO jj = 1, inobf … … 319 319 jk = jk + 1 320 320 ifileidx(jk) = jj 321 i seaiceidx(jk) = ji321 ilogchlidx(jk) = ji 322 322 zdat(jk) = inpfiles(jj)%ptim(ji) 323 323 ENDIF … … 328 328 & iindx ) 329 329 330 CALL obs_surf_alloc( seaicedata, iobs, &330 CALL obs_surf_alloc( logchldata, iobs, & 331 331 kvars, kextr, kstp, jpi, jpj ) 332 332 333 ! * Read obs/positions, QC, all variable and assign to seaicedata333 ! * Read obs/positions, QC, all variable and assign to logchldata 334 334 335 335 iobs = 0 … … 343 343 344 344 jj = ifileidx(iindx(jk)) 345 ji = i seaiceidx(iindx(jk))345 ji = ilogchlidx(iindx(jk)) 346 346 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 347 347 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 370 370 371 371 372 ! seaicetime coordinates373 seaicedata%nyea(iobs) = iyea374 seaicedata%nmon(iobs) = imon375 seaicedata%nday(iobs) = iday376 seaicedata%nhou(iobs) = ihou377 seaicedata%nmin(iobs) = imin372 ! logchl time coordinates 373 logchldata%nyea(iobs) = iyea 374 logchldata%nmon(iobs) = imon 375 logchldata%nday(iobs) = iday 376 logchldata%nhou(iobs) = ihou 377 logchldata%nmin(iobs) = imin 378 378 379 ! seaicespace coordinates380 seaicedata%rlam(iobs) = inpfiles(jj)%plam(ji)381 seaicedata%rphi(iobs) = inpfiles(jj)%pphi(ji)379 ! logchl space coordinates 380 logchldata%rlam(iobs) = inpfiles(jj)%plam(ji) 381 logchldata%rphi(iobs) = inpfiles(jj)%pphi(ji) 382 382 383 383 ! Coordinate search parameters 384 seaicedata%mi (iobs) = inpfiles(jj)%iobsi(ji,1)385 seaicedata%mj (iobs) = inpfiles(jj)%iobsj(ji,1)384 logchldata%mi (iobs) = inpfiles(jj)%iobsi(ji,1) 385 logchldata%mj (iobs) = inpfiles(jj)%iobsj(ji,1) 386 386 387 387 ! Instrument type … … 392 392 itype = 0 393 393 ENDIF 394 seaicedata%ntyp(iobs) = itype395 IF ( itype < i seaicemaxtype + 1 ) THEN394 logchldata%ntyp(iobs) = itype 395 IF ( itype < ilogchlmaxtype + 1 ) THEN 396 396 ityp(itype+1) = ityp(itype+1) + 1 397 397 ELSE 398 IF(lwp)WRITE(numout,*)'WARNING:Increase i seaicemaxtype in ',&398 IF(lwp)WRITE(numout,*)'WARNING:Increase ilogchlmaxtype in ',& 399 399 & cpname 400 400 ENDIF 401 401 402 402 ! Bookkeeping data to match observations 403 seaicedata%nsidx(iobs) = iobs404 seaicedata%nsfil(iobs) = iindx(jk)403 logchldata%nsidx(iobs) = iobs 404 logchldata%nsfil(iobs) = iindx(jk) 405 405 406 406 ! QC flags 407 seaicedata%nqc(iobs) = inpfiles(jj)%ivqc(ji,1)407 logchldata%nqc(iobs) = inpfiles(jj)%ivqc(ji,1) 408 408 409 409 ! Observed value 410 seaicedata%robs(iobs,1) = inpfiles(jj)%pob(1,ji,1)410 logchldata%robs(iobs,1) = inpfiles(jj)%pob(1,ji,1) 411 411 412 412 413 413 ! Model and MDT is set to fbrmdi unless read from file 414 414 IF ( ldmod ) THEN 415 seaicedata%rmod(iobs,1) = inpfiles(jj)%padd(1,ji,1,1)415 logchldata%rmod(iobs,1) = inpfiles(jj)%padd(1,ji,1,1) 416 416 ELSE 417 seaicedata%rmod(iobs,1) = fbrmdi417 logchldata%rmod(iobs,1) = fbrmdi 418 418 ENDIF 419 419 ENDIF … … 434 434 435 435 WRITE(numout,*) 436 WRITE(numout,'(1X,A)')' Seaicedata types'436 WRITE(numout,'(1X,A)')'logchl data types' 437 437 WRITE(numout,'(1X,A)')'-----------------' 438 438 DO jj = 1,8 … … 450 450 ! Deallocate temporary data 451 451 !----------------------------------------------------------------------- 452 DEALLOCATE( ifileidx, i seaiceidx, zdat )452 DEALLOCATE( ifileidx, ilogchlidx, zdat ) 453 453 454 454 !----------------------------------------------------------------------- … … 460 460 DEALLOCATE( inpfiles ) 461 461 462 END SUBROUTINE obs_rea_ seaice463 464 END MODULE obs_read_ seaice465 462 END SUBROUTINE obs_rea_logchl 463 464 END MODULE obs_read_logchl 465 -
branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90
r5838 r6854 11 11 !! obs_wri_seaice: Write seaice observation related diagnostics 12 12 !! obs_wri_vel : Write velocity observation diagnostics in NetCDF format 13 !! obs_wri_logchl: Write logchl observation related diagnostics 13 14 !! obs_wri_stats : Print basic statistics on the data being written out 14 15 !!---------------------------------------------------------------------- … … 45 46 & obs_wri_seaice, & ! Write seaice observation related diagnostics 46 47 & obs_wri_vel, & ! Write velocity observation related diagnostics 48 & obs_wri_logchl, & ! Write logchl observation related diagnostics 47 49 & obswriinfo 48 50 … … 930 932 END SUBROUTINE obs_wri_vel 931 933 934 SUBROUTINE obs_wri_logchl( cprefix, logchldata, padd, pext ) 935 !!----------------------------------------------------------------------- 936 !! 937 !! *** ROUTINE obs_wri_logchl *** 938 !! 939 !! ** Purpose : Write logchl observation diagnostics 940 !! related 941 !! 942 !! ** Method : NetCDF 943 !! 944 !! ** Action : 945 !! 946 !!----------------------------------------------------------------------- 947 948 !! * Modules used 949 IMPLICIT NONE 950 951 !! * Arguments 952 CHARACTER(LEN=*), INTENT(IN) :: cprefix ! Prefix for output files 953 TYPE(obs_surf), INTENT(INOUT) :: logchldata ! Full set of logchl 954 TYPE(obswriinfo), OPTIONAL :: padd ! Additional info for each variable 955 TYPE(obswriinfo), OPTIONAL :: pext ! Extra info 956 957 !! * Local declarations 958 TYPE(obfbdata) :: fbdata 959 CHARACTER(LEN=40) :: cfname ! netCDF filename 960 CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_logchl' 961 INTEGER :: jo 962 INTEGER :: ja 963 INTEGER :: je 964 INTEGER :: nadd 965 INTEGER :: next 966 967 IF ( PRESENT( padd ) ) THEN 968 nadd = padd%inum 969 ELSE 970 nadd = 0 971 ENDIF 972 973 IF ( PRESENT( pext ) ) THEN 974 next = pext%inum 975 ELSE 976 next = 0 977 ENDIF 978 979 CALL init_obfbdata( fbdata ) 980 981 CALL alloc_obfbdata( fbdata, 1, logchldata%nsurf, 1, & 982 & 1 + nadd, next, .TRUE. ) 983 984 fbdata%cname(1) = 'LOGCHL' 985 fbdata%coblong(1) = 'logchl concentration' 986 fbdata%cobunit(1) = 'mg/m3' 987 DO je = 1, next 988 fbdata%cextname(je) = pext%cdname(je) 989 fbdata%cextlong(je) = pext%cdlong(je,1) 990 fbdata%cextunit(je) = pext%cdunit(je,1) 991 END DO 992 fbdata%caddname(1) = 'Hx' 993 fbdata%caddlong(1,1) = 'Model interpolated LOGCHL' 994 fbdata%caddunit(1,1) = 'mg/m3' 995 fbdata%cgrid(1) = 'T' 996 DO ja = 1, nadd 997 fbdata%caddname(1+ja) = padd%cdname(ja) 998 fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 999 fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 1000 END DO 1001 1002 WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc 1003 1004 IF(lwp) THEN 1005 WRITE(numout,*) 1006 WRITE(numout,*)'obs_wri_logchl :' 1007 WRITE(numout,*)'~~~~~~~~~~~~~~~~' 1008 WRITE(numout,*)'Writing logchl feedback file : ',TRIM(cfname) 1009 ENDIF 1010 1011 ! Transform obs_prof data structure into obfbdata structure 1012 fbdata%cdjuldref = '19500101000000' 1013 DO jo = 1, logchldata%nsurf 1014 fbdata%plam(jo) = logchldata%rlam(jo) 1015 fbdata%pphi(jo) = logchldata%rphi(jo) 1016 WRITE(fbdata%cdtyp(jo),'(I4)') logchldata%ntyp(jo) 1017 fbdata%ivqc(jo,:) = 0 1018 fbdata%ivqcf(:,jo,:) = 0 1019 IF ( logchldata%nqc(jo) > 10 ) THEN 1020 fbdata%ioqc(jo) = 4 1021 fbdata%ioqcf(1,jo) = 0 1022 fbdata%ioqcf(2,jo) = logchldata%nqc(jo) - 10 1023 ELSE 1024 fbdata%ioqc(jo) = MAX(logchldata%nqc(jo),1) 1025 fbdata%ioqcf(:,jo) = 0 1026 ENDIF 1027 fbdata%ipqc(jo) = 0 1028 fbdata%ipqcf(:,jo) = 0 1029 fbdata%itqc(jo) = 0 1030 fbdata%itqcf(:,jo) = 0 1031 fbdata%cdwmo(jo) = '' 1032 fbdata%kindex(jo) = logchldata%nsfil(jo) 1033 IF (ln_grid_global) THEN 1034 fbdata%iobsi(jo,1) = logchldata%mi(jo) 1035 fbdata%iobsj(jo,1) = logchldata%mj(jo) 1036 ELSE 1037 fbdata%iobsi(jo,1) = mig(logchldata%mi(jo)) 1038 fbdata%iobsj(jo,1) = mjg(logchldata%mj(jo)) 1039 ENDIF 1040 CALL greg2jul( 0, & 1041 & logchldata%nmin(jo), & 1042 & logchldata%nhou(jo), & 1043 & logchldata%nday(jo), & 1044 & logchldata%nmon(jo), & 1045 & logchldata%nyea(jo), & 1046 & fbdata%ptim(jo), & 1047 & krefdate = 19500101 ) 1048 fbdata%padd(1,jo,1,1) = logchldata%rmod(jo,1) 1049 fbdata%pob(1,jo,1) = logchldata%robs(jo,1) 1050 fbdata%pdep(1,jo) = 0.0 1051 fbdata%idqc(1,jo) = 0 1052 fbdata%idqcf(:,1,jo) = 0 1053 IF ( logchldata%nqc(jo) > 10 ) THEN 1054 fbdata%ivlqc(1,jo,1) = 4 1055 fbdata%ivlqcf(1,1,jo,1) = 0 1056 fbdata%ivlqcf(2,1,jo,1) = logchldata%nqc(jo) - 10 1057 ELSE 1058 fbdata%ivlqc(1,jo,1) = MAX(logchldata%nqc(jo),1) 1059 fbdata%ivlqcf(:,1,jo,1) = 0 1060 ENDIF 1061 fbdata%iobsk(1,jo,1) = 0 1062 DO ja = 1, nadd 1063 fbdata%padd(1,jo,1+ja,1) = & 1064 & logchldata%rext(jo,padd%ipoint(ja)) 1065 END DO 1066 DO je = 1, next 1067 fbdata%pext(1,jo,je) = & 1068 & logchldata%rext(jo,pext%ipoint(je)) 1069 END DO 1070 1071 END DO 1072 1073 ! Write the obfbdata structure 1074 CALL write_obfbdata( cfname, fbdata ) 1075 1076 ! Output some basic statistics 1077 CALL obs_wri_stats( fbdata ) 1078 1079 CALL dealloc_obfbdata( fbdata ) 1080 1081 END SUBROUTINE obs_wri_logchl 1082 932 1083 SUBROUTINE obs_wri_stats( fbdata ) 933 1084 !!----------------------------------------------------------------------- -
branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obslogchl_io.h90
r6845 r6854 5 5 !!---------------------------------------------------------------------- 6 6 7 SUBROUTINE read_ seaice( cdfilename, inpfile, kunit, ldwp, ldgrid )7 SUBROUTINE read_logchl( cdfilename, inpfile, kunit, ldwp, ldgrid ) 8 8 !!--------------------------------------------------------------------- 9 9 !! 10 !! ** ROUTINE read_ seaice**11 !! 12 !! ** Purpose : Read from file the SEAICEobservations.10 !! ** ROUTINE read_logchl ** 11 !! 12 !! ** Purpose : Read from file the logchl observations. 13 13 !! 14 14 !! ** Method : The data file is a NetCDF file. … … 28 28 LOGICAL :: ldgrid ! Save grid info in data structure 29 29 !! * Local declarations 30 CHARACTER(LEN=12),PARAMETER :: cpname = 'read_ seaice'30 CHARACTER(LEN=12),PARAMETER :: cpname = 'read_logchl' 31 31 INTEGER :: i_file_id ! netcdf IDS 32 32 INTEGER :: i_time_id … … 41 41 & i_dtime, & ! Offset in seconds since reference time 42 42 & i_qc, & ! Quality control flag. 43 & i_type ! Type of seaicemeasurement.43 & i_type ! Type of logchl measurement. 44 44 REAL(wp), DIMENSION(:), POINTER :: & 45 45 & z_phi, & ! Latitudes 46 46 & z_lam ! Longitudes 47 47 REAL(wp), DIMENSION(:,:), POINTER :: & 48 & z_ seaice ! Seaicedata48 & z_logchl ! logchl data 49 49 INTEGER, PARAMETER :: imaxdim = 2 ! Assumed maximum for no. dims. in file 50 50 INTEGER, DIMENSION(2) :: idims ! Dimensions in file … … 94 94 & z_phi ( i_data ), & 95 95 & z_lam ( i_data ), & 96 & z_ seaice( i_data,i_time ) &96 & z_logchl ( i_data,i_time ) & 97 97 & ) 98 98 … … 124 124 ! Get list of times for each ob in seconds relative to reference time 125 125 126 CALL chkerr( nf90_inq_varid( i_file_id, ' SeaIce_dtime', i_var_id ), &126 CALL chkerr( nf90_inq_varid( i_file_id, 'LogChl_dtime', i_var_id ), & 127 127 & cpname, __LINE__ ) 128 128 idims(1) = i_data … … 164 164 & cpname, __LINE__ ) 165 165 166 ! Get seaicedata167 168 CALL chkerr( nf90_inq_varid( i_file_id, ' sea_ice_concentration', &166 ! Get logchl data 167 168 CALL chkerr( nf90_inq_varid( i_file_id, 'LogChl', & 169 169 & i_var_id ), & 170 170 & cpname, __LINE__ ) … … 172 172 idims(2) = i_time 173 173 CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ ) 174 CALL chkerr( nf90_get_var ( i_file_id, i_var_id, z_ seaice), &174 CALL chkerr( nf90_get_var ( i_file_id, i_var_id, z_logchl), & 175 175 & cpname, __LINE__ ) 176 176 zoff = 0. 177 IF (nf90_inquire_attribute( i_file_id, i_var_id, " scale_factor") &178 & == nf90_noerr) THEN 179 CALL chkerr( nf90_get_att( i_file_id, i_var_id, & 180 & " scale_factor",zsca), cpname, __LINE__ )177 IF (nf90_inquire_attribute( i_file_id, i_var_id, "add_offset") & 178 & == nf90_noerr) THEN 179 CALL chkerr( nf90_get_att( i_file_id, i_var_id, & 180 & "add_offset", zoff), cpname, __LINE__ ) 181 181 ENDIF 182 182 zsca = 1.0 … … 192 192 & "_FillValue",zfill), cpname, __LINE__ ) 193 193 ENDIF 194 WHERE(z_ seaice(:,:) /= zfill)195 z_ seaice(:,:) = (zsca * z_seaice(:,:)) + zoff194 WHERE(z_logchl(:,:) /= zfill) 195 z_logchl(:,:) = (zsca * z_logchl(:,:)) + zoff 196 196 ELSEWHERE 197 z_ seaice(:,:) = fbrmdi197 z_logchl(:,:) = fbrmdi 198 198 END WHERE 199 199 … … 208 208 & cpname, __LINE__ ) 209 209 210 ! Get seaiceobs type210 ! Get logchl obs type 211 211 212 212 i_type(:,:)=1 … … 223 223 CALL init_obfbdata( inpfile ) 224 224 CALL alloc_obfbdata( inpfile, 1, iobs, 1, 0, 0, ldgrid ) 225 inpfile%cname(1) = ' SEAICE'225 inpfile%cname(1) = 'LOGCHL' 226 226 227 227 ! Fill the obfbdata structure from input data … … 233 233 iobs = iobs + 1 234 234 ! Characters 235 WRITE(inpfile%cdwmo(iobs),'(A6,A2)') ' seaice',' '235 WRITE(inpfile%cdwmo(iobs),'(A6,A2)') 'logchl',' ' 236 236 WRITE(inpfile%cdtyp(iobs),'(I4)') i_type(jobs,jtim) 237 237 ! Real values 238 238 inpfile%plam(iobs) = z_lam(jobs) 239 239 inpfile%pphi(iobs) = z_phi(jobs) 240 inpfile%pob(1,iobs,1) = z_ seaice(jobs,jtim)240 inpfile%pob(1,iobs,1) = z_logchl(jobs,jtim) 241 241 inpfile%ptim(iobs) = & 242 242 & REAL(i_reftime(jtim))/(60.*60.*24.) + & … … 245 245 ! Integers 246 246 inpfile%kindex(iobs) = iobs 247 IF ( z_ seaice(jobs,jtim) == fbrmdi ) THEN247 IF ( z_logchl(jobs,jtim) == fbrmdi ) THEN 248 248 inpfile%ioqc(iobs) = 4 249 249 inpfile%ivqc(iobs,1) = 4 … … 266 266 END DO 267 267 268 END SUBROUTINE read_ seaice269 270 268 END SUBROUTINE read_logchl 269 270
Note: See TracChangeset
for help on using the changeset viewer.
