Changeset 14165 for branches/UKMO/dev_r5518_obs_oper_update_sit_SMOS/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
- Timestamp:
- 2020-12-12T12:31:26+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_obs_oper_update_sit_SMOS/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
r12820 r14165 51 51 LOGICAL :: ln_sstnight !: Logical switch for night mean SST obs 52 52 LOGICAL :: ln_default_fp_indegs !: T=> Default obs footprint size specified in degrees, F=> in metres 53 LOGICAL :: ln_sla_fp_indegs !: T=> SLA obs footprint size specified in degrees, F=> in metres 54 LOGICAL :: ln_sst_fp_indegs !: T=> SST obs footprint size specified in degrees, F=> in metres 55 LOGICAL :: ln_sss_fp_indegs !: T=> SSS obs footprint size specified in degrees, F=> in metres 53 LOGICAL :: ln_sla_fp_indegs !: T=> SLA obs footprint size specified in degrees, F=> in metres 54 LOGICAL :: ln_sst_fp_indegs !: T=> SST obs footprint size specified in degrees, F=> in metres 55 LOGICAL :: ln_sss_fp_indegs !: T=> SSS obs footprint size specified in degrees, F=> in metres 56 LOGICAL :: ln_ssv_fp_indegs !: T=> SSV obs footprint size specified in degrees, F=> in metres 56 57 LOGICAL :: ln_sic_fp_indegs !: T=> SIC obs footprint size specified in degrees, F=> in metres 57 58 LOGICAL :: ln_sit_fp_indegs !: T=> SIT obs footprint size specified in degrees, F=> in metres … … 68 69 REAL(wp) :: rn_sss_avglamscl !: E/W diameter of SSS observation footprint 69 70 REAL(wp) :: rn_sss_avgphiscl !: N/S diameter of SSS observation footprint 71 REAL(wp) :: rn_ssv_avglamscl !: E/W diameter of SSV observation footprint 72 REAL(wp) :: rn_ssv_avgphiscl !: N/S diameter of SSV observation footprint 70 73 REAL(wp) :: rn_sic_avglamscl !: E/W diameter of SIC observation footprint 71 74 REAL(wp) :: rn_sic_avgphiscl !: N/S diameter of SIC observation footprint … … 83 86 INTEGER :: nn_2dint_sst !: SST horizontal interpolation method (-1 = default) 84 87 INTEGER :: nn_2dint_sss !: SSS horizontal interpolation method (-1 = default) 88 INTEGER :: nn_2dint_ssv !: SSV horizontal interpolation method (-1 = default) 85 89 INTEGER :: nn_2dint_sic !: SIC horizontal interpolation method (-1 = default) 86 90 INTEGER :: nn_2dint_sit !: SIT horizontal interpolation method (-1 = default) … … 174 178 & cn_velfbfiles, & ! Velocity profile input filenames 175 179 & cn_sssfbfiles, & ! Sea surface salinity input filenames 180 & cn_ssvfbfiles, & ! Sea surface velocity input filenames 176 181 & cn_slchltotfbfiles, & ! Surface total log10(chlorophyll) input filenames 177 182 & cn_slchldiafbfiles, & ! Surface diatom log10(chlorophyll) input filenames … … 213 218 LOGICAL :: ln_fbd ! Logical switch for sea ice freeboard 214 219 LOGICAL :: ln_sss ! Logical switch for sea surface salinity obs 220 LOGICAL :: ln_ssv ! Logical switch for sea surface velocity obs 215 221 LOGICAL :: ln_vel3d ! Logical switch for velocity (u,v) obs 216 222 LOGICAL :: ln_slchltot ! Logical switch for surface total log10(chlorophyll) obs … … 267 273 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: & 268 274 & zmask ! Model land/sea mask associated with variables 275 REAL(wp), POINTER, DIMENSION(:,:,:) :: & 276 & zmask_surf ! Surface model land/sea mask associated with variables 269 277 270 278 271 279 NAMELIST/namobs/ln_diaobs, ln_t3d, ln_s3d, ln_sla, & 272 280 & ln_sst, ln_sic, ln_sit, ln_fbd, & 273 & ln_sss, ln_ vel3d,&281 & ln_sss, ln_ssv, ln_vel3d, & 274 282 & ln_slchltot, ln_slchldia, ln_slchlnon, & 275 283 & ln_slchldin, ln_slchlmic, ln_slchlnan, & … … 287 295 & ln_time_mean_sla_bkg, ln_default_fp_indegs, & 288 296 & ln_sla_fp_indegs, ln_sst_fp_indegs, & 289 & ln_sss_fp_indegs, ln_sic_fp_indegs, & 290 & ln_sit_fp_indegs, ln_fbd_fp_indegs, & 297 & ln_sss_fp_indegs, ln_ssv_fp_indegs, & 298 & ln_sic_fp_indegs, ln_sit_fp_indegs, & 299 & ln_fbd_fp_indegs, & 291 300 & cn_profbfiles, cn_slafbfiles, & 292 301 & cn_sstfbfiles, cn_sicfbfiles, & 293 302 & cn_sitfbfiles, cn_fbdfbfiles, & 294 & cn_velfbfiles, cn_sssfbfiles, 303 & cn_velfbfiles, cn_sssfbfiles, cn_ssvfbfiles, & 295 304 & cn_slchltotfbfiles, cn_slchldiafbfiles, & 296 305 & cn_slchlnonfbfiles, cn_slchldinfbfiles, & … … 312 321 & rn_sst_avglamscl, rn_sst_avgphiscl, & 313 322 & rn_sss_avglamscl, rn_sss_avgphiscl, & 323 & rn_ssv_avglamscl, rn_ssv_avgphiscl, & 314 324 & rn_sic_avglamscl, rn_sic_avgphiscl, & 315 325 & rn_sit_avglamscl, rn_sit_avgphiscl, & … … 317 327 & nn_1dint, nn_2dint_default, & 318 328 & nn_2dint_sla, nn_2dint_sst, & 319 & nn_2dint_sss, nn_2dint_sic, & 320 & nn_2dint_sit, nn_2dint_fbd, & 329 & nn_2dint_sss, nn_2dint_ssv, & 330 & nn_2dint_sic, nn_2dint_sit, & 331 & nn_2dint_fbd, & 321 332 & nn_msshc, rn_mdtcorr, rn_mdtcutoff, & 322 333 & nn_profdavtypes … … 335 346 cn_velfbfiles(:) = '' 336 347 cn_sssfbfiles(:) = '' 348 cn_ssvfbfiles(:) = '' 337 349 cn_slchltotfbfiles(:) = '' 338 350 cn_slchldiafbfiles(:) = '' … … 400 412 WRITE(numout,*) ' Logical switch for velocity observations ln_vel3d = ', ln_vel3d 401 413 WRITE(numout,*) ' Logical switch for SSS observations ln_sss = ', ln_sss 414 WRITE(numout,*) ' Logical switch for SSV observations ln_ssv = ', ln_ssv 402 415 WRITE(numout,*) ' Logical switch for surface total logchl obs ln_slchltot = ', ln_slchltot 403 416 WRITE(numout,*) ' Logical switch for surface diatom logchl obs ln_slchldia = ', ln_slchldia … … 435 448 WRITE(numout,*) ' Type of horizontal interpolation method for SST nn_2dint_sst = ', nn_2dint_sst 436 449 WRITE(numout,*) ' Type of horizontal interpolation method for SSS nn_2dint_sss = ', nn_2dint_sss 450 WRITE(numout,*) ' Type of horizontal interpolation method for SSV nn_2dint_ssv = ', nn_2dint_ssv 437 451 WRITE(numout,*) ' Type of horizontal interpolation method for SIC nn_2dint_sic = ', nn_2dint_sic 438 452 WRITE(numout,*) ' Type of horizontal interpolation method for SIT nn_2dint_sit = ', nn_2dint_sit … … 477 491 & ln_pchltot, ln_pno3, ln_psi4, ln_ppo4, & 478 492 & ln_pdic, ln_palk, ln_pph, ln_po2 /) ) 479 nsurftypes = COUNT( (/ln_sla, ln_sst, ln_sic, ln_sit, ln_fbd, ln_sss, & 493 nsurftypes = COUNT( (/ln_sla, ln_sst, ln_sic, ln_sit, ln_fbd, & 494 & ln_sss, ln_ssv, & 480 495 & ln_slchltot, ln_slchldia, ln_slchlnon, ln_slchldin, & 481 496 & ln_slchlmic, ln_slchlnan, ln_slchlpic, ln_schltot, & … … 611 626 cobstypessurf(jtype) = 'sss' 612 627 clsurffiles(jtype,:) = cn_sssfbfiles 628 ENDIF 629 IF (ln_ssv) THEN 630 jtype = jtype + 1 631 cobstypessurf(jtype) = 'ssv' 632 clsurffiles(jtype,:) = cn_ssvfbfiles 613 633 ENDIF 614 634 IF (ln_slchltot) THEN … … 751 771 ztype_avgphiscl = rn_sss_avgphiscl 752 772 ltype_fp_indegs = ln_sss_fp_indegs 773 ltype_night = .FALSE. 774 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'ssv' ) THEN 775 IF ( nn_2dint_ssv == -1 ) THEN 776 n2dint_type = nn_2dint_default 777 ELSE 778 n2dint_type = nn_2dint_ssv 779 ENDIF 780 ztype_avglamscl = rn_ssv_avglamscl 781 ztype_avgphiscl = rn_ssv_avgphiscl 782 ltype_fp_indegs = ln_ssv_fp_indegs 753 783 ltype_night = .FALSE. 754 784 ELSE … … 934 964 nvarssurf(jtype) = 1 935 965 nextrsurf(jtype) = 2 966 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'ssv' ) THEN 967 nvarssurf(jtype) = 2 968 nextrsurf(jtype) = 0 936 969 ELSE 937 970 nvarssurf(jtype) = 1 … … 940 973 941 974 ALLOCATE( clvars( nvarssurf(jtype) ) ) 942 975 CALL wrk_alloc( jpi, jpj, nvarssurf(jtype), zglam ) 976 CALL wrk_alloc( jpi, jpj, nvarssurf(jtype), zgphi ) 977 CALL wrk_alloc( jpi, jpj, nvarssurf(jtype), zmask_surf ) 978 979 IF ( TRIM(cobstypessurf(jtype)) == 'ssv' ) THEN 980 zglam(:,:,1) = glamu(:,:) 981 zglam(:,:,2) = glamv(:,:) 982 zgphi(:,:,1) = gphiu(:,:) 983 zgphi(:,:,2) = gphiv(:,:) 984 zmask_surf(:,:,1) = umask(:,:,1) 985 zmask_surf(:,:,2) = vmask(:,:,1) 986 ELSE 987 DO jvar = 1, nvarssurf(jtype) 988 zglam(:,:,jvar) = glamt(:,:) 989 zgphi(:,:,jvar) = gphit(:,:) 990 zmask_surf(:,:,jvar) = tmask(:,:,1) 991 END DO 992 ENDIF 993 943 994 IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) THEN 944 995 clvars(1) = 'SLA' … … 955 1006 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sss' ) THEN 956 1007 clvars(1) = 'SSS' 1008 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'ssv' ) THEN 1009 clvars(1) = 'UVEL' 1010 clvars(2) = 'VVEL' 957 1011 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'slchltot' ) THEN 958 1012 clvars(1) = 'SLCHLTOT' … … 994 1048 & llnightav(jtype), ltype_clim, ln_time_mean_sla_bkg, clvars ) 995 1049 996 CALL obs_pre_surf( surfdata(jtype), surfdataqc(jtype), ln_nea, ln_bound_reject, ln_seaicetypes ) 1050 CALL obs_pre_surf( surfdata(jtype), surfdataqc(jtype), & 1051 & jpi, jpj, & 1052 & zmask_surf, zglam, zgphi, & 1053 & ln_nea, ln_bound_reject, ln_seaicetypes ) 997 1054 998 1055 IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) THEN … … 1024 1081 1025 1082 DEALLOCATE( clvars ) 1083 CALL wrk_dealloc( jpi, jpj, nvarssurf(jtype), zglam ) 1084 CALL wrk_dealloc( jpi, jpj, nvarssurf(jtype), zgphi ) 1085 CALL wrk_dealloc( jpi, jpj, nvarssurf(jtype), zmask_surf ) 1026 1086 1027 1087 END DO … … 1104 1164 #elif defined key_fabm 1105 1165 USE par_fabm ! FABM parameters 1106 USE fabm, ONLY: &1107 & fabm_get_interior_diagnostic_data1108 1166 #endif 1109 1167 #if defined key_spm … … 1128 1186 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: & 1129 1187 & zprofmask ! Mask associated with zprofvar 1130 REAL(wp), POINTER, DIMENSION(:,: ) :: &1188 REAL(wp), POINTER, DIMENSION(:,:,:) :: & 1131 1189 & zsurfvar, & ! Model values equivalent to surface ob. 1132 1190 & zsurfclim, & ! Climatology values for variables in a surface ob. 1133 1191 & zsurfmask ! Mask associated with surface variable 1134 1192 REAL(wp), POINTER, DIMENSION(:,:,:) :: & 1135 & zglam, & ! Model longitudes for prof variables1136 & zgphi ! Model latitudes for prof variables1193 & zglam, & ! Model longitudes 1194 & zgphi ! Model latitudes 1137 1195 LOGICAL :: llog10 ! Perform log10 transform of variable 1138 1196 #if defined key_fabm … … 1316 1374 #elif defined key_fabm 1317 1375 ! Alkalinity from ERSEM 1318 zprofvar(:,:,:,1) = fabm_get_interior_diagnostic_data(model,jp_fabm_o3ta)1376 zprofvar(:,:,:,1) = model%get_interior_diagnostic_data(jp_fabm_o3ta) 1319 1377 #else 1320 1378 CALL ctl_stop( ' Trying to run palk observation operator', & … … 1331 1389 #elif defined key_fabm 1332 1390 ! pH from ERSEM 1333 zprofvar(:,:,:,1) = trn(:,:,:,jp_fabm_m1+jp_fabm_o3ph)1391 zprofvar(:,:,:,1) = model%get_interior_diagnostic_data(jp_fabm_o3ph) 1334 1392 #else 1335 1393 CALL ctl_stop( ' Trying to run pph observation operator', & … … 1380 1438 1381 1439 IF ( nsurftypes > 0 ) THEN 1382 1383 !Allocate local work arrays 1384 CALL wrk_alloc( jpi, jpj, zsurfvar ) 1385 CALL wrk_alloc( jpi, jpj, zsurfclim ) 1386 CALL wrk_alloc( jpi, jpj, zsurfmask ) 1440 1387 1441 #if defined key_fabm 1388 1442 CALL wrk_alloc( jpi, jpj, jpk, fabm_3d ) … … 1391 1445 DO jtype = 1, nsurftypes 1392 1446 1447 !Allocate local work arrays 1448 CALL wrk_alloc( jpi, jpj, surfdataqc(jtype)%nvar, zsurfvar ) 1449 CALL wrk_alloc( jpi, jpj, surfdataqc(jtype)%nvar, zsurfclim ) 1450 CALL wrk_alloc( jpi, jpj, surfdataqc(jtype)%nvar, zsurfmask ) 1451 CALL wrk_alloc( jpi, jpj, surfdataqc(jtype)%nvar, zglam ) 1452 CALL wrk_alloc( jpi, jpj, surfdataqc(jtype)%nvar, zgphi ) 1453 1393 1454 !Defaults which might be changed 1394 zsurfmask(:,:) = tmask(:,:,1) 1395 zsurfclim(:,:) = 0._wp 1455 DO jvar = 1, surfdataqc(jtype)%nvar 1456 zsurfmask(:,:,jvar) = tmask(:,:,1) 1457 zsurfclim(:,:,jvar) = 0._wp 1458 zglam(:,:,jvar) = glamt(:,:) 1459 zgphi(:,:,jvar) = gphit(:,:) 1460 END DO 1396 1461 llog10 = .FALSE. 1397 1462 1398 1463 SELECT CASE ( TRIM(cobstypessurf(jtype)) ) 1399 1464 CASE('sst') 1400 zsurfvar(:,: ) = tsn(:,:,1,jp_tem)1401 IF ( ln_output_clim ) zsurfclim(:,: ) = tclim(:,:,1)1465 zsurfvar(:,:,1) = tsn(:,:,1,jp_tem) 1466 IF ( ln_output_clim ) zsurfclim(:,:,1) = tclim(:,:,1) 1402 1467 CASE('sla') 1403 zsurfvar(:,: ) = sshn(:,:)1468 zsurfvar(:,:,1) = sshn(:,:) 1404 1469 CASE('sss') 1405 zsurfvar(:,:) = tsn(:,:,1,jp_sal) 1406 IF ( ln_output_clim ) zsurfclim(:,:) = sclim(:,:,1) 1470 zsurfvar(:,:,1) = tsn(:,:,1,jp_sal) 1471 IF ( ln_output_clim ) zsurfclim(:,:,1) = sclim(:,:,1) 1472 CASE('ssv') 1473 zsurfvar(:,:,1) = un(:,:,1) 1474 zsurfvar(:,:,2) = vn(:,:,1) 1475 zsurfmask(:,:,1) = umask(:,:,1) 1476 zsurfmask(:,:,2) = vmask(:,:,1) 1477 zglam(:,:,1) = glamu(:,:) 1478 zglam(:,:,2) = glamv(:,:) 1479 zgphi(:,:,1) = gphiu(:,:) 1480 zgphi(:,:,2) = gphiv(:,:) 1407 1481 CASE('sic') 1408 1482 IF ( kstp == 0 ) THEN … … 1415 1489 ELSE 1416 1490 #if defined key_cice 1417 zsurfvar(:,: ) = fr_i(:,:)1491 zsurfvar(:,:,1) = fr_i(:,:) 1418 1492 #elif defined key_lim2 || defined key_lim3 1419 zsurfvar(:,: ) = 1._wp - frld(:,:)1493 zsurfvar(:,:,1) = 1._wp - frld(:,:) 1420 1494 #else 1421 1495 CALL ctl_stop( ' Trying to run sea-ice concentration observation operator', & … … 1434 1508 ELSE 1435 1509 #if defined key_cice 1436 zsurfvar(:,: ) = thick_i(:,:)1510 zsurfvar(:,:,1) = thick_i(:,:) 1437 1511 #elif defined key_lim2 || defined key_lim3 1438 1512 CALL ctl_stop( ' No sea-ice thickness observation operator defined for LIM model' ) … … 1465 1539 #if defined key_hadocc 1466 1540 ! Surface chlorophyll from HadOCC 1467 zsurfvar(:,: ) = HADOCC_CHL(:,:,1)1541 zsurfvar(:,:,1) = HADOCC_CHL(:,:,1) 1468 1542 #elif defined key_medusa 1469 1543 ! Add non-diatom and diatom surface chlorophyll from MEDUSA 1470 zsurfvar(:,: ) = trn(:,:,1,jpchn) + trn(:,:,1,jpchd)1544 zsurfvar(:,:,1) = trn(:,:,1,jpchn) + trn(:,:,1,jpchd) 1471 1545 #elif defined key_fabm 1472 1546 ! Add all surface chlorophyll groups from ERSEM 1473 zsurfvar(:,: ) = trn(:,:,1,jp_fabm_m1+jp_fabm_chl1) + trn(:,:,1,jp_fabm_m1+jp_fabm_chl2) + &1547 zsurfvar(:,:,1) = trn(:,:,1,jp_fabm_m1+jp_fabm_chl1) + trn(:,:,1,jp_fabm_m1+jp_fabm_chl2) + & 1474 1548 & trn(:,:,1,jp_fabm_m1+jp_fabm_chl3) + trn(:,:,1,jp_fabm_m1+jp_fabm_chl4) 1475 1549 #else … … 1485 1559 #elif defined key_medusa 1486 1560 ! Diatom surface chlorophyll from MEDUSA 1487 zsurfvar(:,: ) = trn(:,:,1,jpchd)1561 zsurfvar(:,:,1) = trn(:,:,1,jpchd) 1488 1562 #elif defined key_fabm 1489 1563 ! Diatom surface chlorophyll from ERSEM 1490 zsurfvar(:,: ) = trn(:,:,1,jp_fabm_m1+jp_fabm_chl1)1564 zsurfvar(:,:,1) = trn(:,:,1,jp_fabm_m1+jp_fabm_chl1) 1491 1565 #else 1492 1566 CALL ctl_stop( ' Trying to run slchldia observation operator', & … … 1501 1575 #elif defined key_medusa 1502 1576 ! Non-diatom surface chlorophyll from MEDUSA 1503 zsurfvar(:,: ) = trn(:,:,1,jpchn)1577 zsurfvar(:,:,1) = trn(:,:,1,jpchn) 1504 1578 #elif defined key_fabm 1505 1579 ! Add all non-diatom surface chlorophyll groups from ERSEM 1506 zsurfvar(:,: ) = trn(:,:,1,jp_fabm_m1+jp_fabm_chl2) + &1580 zsurfvar(:,:,1) = trn(:,:,1,jp_fabm_m1+jp_fabm_chl2) + & 1507 1581 & trn(:,:,1,jp_fabm_m1+jp_fabm_chl3) + trn(:,:,1,jp_fabm_m1+jp_fabm_chl4) 1508 1582 #else … … 1521 1595 #elif defined key_fabm 1522 1596 ! Dinoflagellate surface chlorophyll from ERSEM 1523 zsurfvar(:,: ) = trn(:,:,1,jp_fabm_m1+jp_fabm_chl4)1597 zsurfvar(:,:,1) = trn(:,:,1,jp_fabm_m1+jp_fabm_chl4) 1524 1598 #else 1525 1599 CALL ctl_stop( ' Trying to run slchldin observation operator', & … … 1537 1611 #elif defined key_fabm 1538 1612 ! Add diatom and dinoflagellate surface chlorophyll from ERSEM 1539 zsurfvar(:,: ) = trn(:,:,1,jp_fabm_m1+jp_fabm_chl1) + trn(:,:,1,jp_fabm_m1+jp_fabm_chl4)1613 zsurfvar(:,:,1) = trn(:,:,1,jp_fabm_m1+jp_fabm_chl1) + trn(:,:,1,jp_fabm_m1+jp_fabm_chl4) 1540 1614 #else 1541 1615 CALL ctl_stop( ' Trying to run slchlmic observation operator', & … … 1553 1627 #elif defined key_fabm 1554 1628 ! Nanophytoplankton surface chlorophyll from ERSEM 1555 zsurfvar(:,: ) = trn(:,:,1,jp_fabm_m1+jp_fabm_chl2)1629 zsurfvar(:,:,1) = trn(:,:,1,jp_fabm_m1+jp_fabm_chl2) 1556 1630 #else 1557 1631 CALL ctl_stop( ' Trying to run slchlnan observation operator', & … … 1569 1643 #elif defined key_fabm 1570 1644 ! Picophytoplankton surface chlorophyll from ERSEM 1571 zsurfvar(:,: ) = trn(:,:,1,jp_fabm_m1+jp_fabm_chl3)1645 zsurfvar(:,:,1) = trn(:,:,1,jp_fabm_m1+jp_fabm_chl3) 1572 1646 #else 1573 1647 CALL ctl_stop( ' Trying to run slchlpic observation operator', & … … 1579 1653 #if defined key_hadocc 1580 1654 ! Surface chlorophyll from HadOCC 1581 zsurfvar(:,: ) = HADOCC_CHL(:,:,1)1655 zsurfvar(:,:,1) = HADOCC_CHL(:,:,1) 1582 1656 #elif defined key_medusa 1583 1657 ! Add non-diatom and diatom surface chlorophyll from MEDUSA 1584 zsurfvar(:,: ) = trn(:,:,1,jpchn) + trn(:,:,1,jpchd)1658 zsurfvar(:,:,1) = trn(:,:,1,jpchn) + trn(:,:,1,jpchd) 1585 1659 #elif defined key_fabm 1586 1660 ! Add all surface chlorophyll groups from ERSEM 1587 zsurfvar(:,: ) = trn(:,:,1,jp_fabm_m1+jp_fabm_chl1) + trn(:,:,1,jp_fabm_m1+jp_fabm_chl2) + &1588 & trn(:,:,1,jp_fabm_m1+jp_fabm_chl3) + trn(:,:,1,jp_fabm_m1+jp_fabm_chl4)1661 zsurfvar(:,:,1) = trn(:,:,1,jp_fabm_m1+jp_fabm_chl1) + trn(:,:,1,jp_fabm_m1+jp_fabm_chl2) + & 1662 & trn(:,:,1,jp_fabm_m1+jp_fabm_chl3) + trn(:,:,1,jp_fabm_m1+jp_fabm_chl4) 1589 1663 #else 1590 1664 CALL ctl_stop( ' Trying to run schltot observation operator', & … … 1595 1669 #if defined key_hadocc 1596 1670 ! Surface phytoplankton nitrogen from HadOCC multiplied by C:N ratio 1597 zsurfvar(:,: ) = trn(:,:,1,jp_had_phy) * c2n_p1671 zsurfvar(:,:,1) = trn(:,:,1,jp_had_phy) * c2n_p 1598 1672 #elif defined key_medusa 1599 1673 ! Add non-diatom and diatom surface phytoplankton nitrogen from MEDUSA 1600 1674 ! multiplied by C:N ratio for each 1601 zsurfvar(:,: ) = (trn(:,:,1,jpphn) * xthetapn) + (trn(:,:,1,jpphd) * xthetapd)1675 zsurfvar(:,:,1) = (trn(:,:,1,jpphn) * xthetapn) + (trn(:,:,1,jpphd) * xthetapd) 1602 1676 #elif defined key_fabm 1603 1677 ! Add all surface phytoplankton carbon groups from ERSEM 1604 zsurfvar(:,: ) = trn(:,:,1,jp_fabm_m1+jp_fabm_p1c) + trn(:,:,1,jp_fabm_m1+jp_fabm_p2c) + &1678 zsurfvar(:,:,1) = trn(:,:,1,jp_fabm_m1+jp_fabm_p1c) + trn(:,:,1,jp_fabm_m1+jp_fabm_p2c) + & 1605 1679 & trn(:,:,1,jp_fabm_m1+jp_fabm_p3c) + trn(:,:,1,jp_fabm_m1+jp_fabm_p4c) 1606 1680 #else … … 1616 1690 #elif defined key_medusa 1617 1691 ! Diatom surface phytoplankton nitrogen from MEDUSA multiplied by C:N ratio 1618 zsurfvar(:,: ) = trn(:,:,1,jpphd) * xthetapd1692 zsurfvar(:,:,1) = trn(:,:,1,jpphd) * xthetapd 1619 1693 #elif defined key_fabm 1620 1694 ! Diatom surface phytoplankton carbon from ERSEM 1621 zsurfvar(:,: ) = trn(:,:,1,jp_fabm_m1+jp_fabm_p1c)1695 zsurfvar(:,:,1) = trn(:,:,1,jp_fabm_m1+jp_fabm_p1c) 1622 1696 #else 1623 1697 CALL ctl_stop( ' Trying to run slphydia observation operator', & … … 1632 1706 #elif defined key_medusa 1633 1707 ! Non-diatom surface phytoplankton nitrogen from MEDUSA multiplied by C:N ratio 1634 zsurfvar(:,: ) = trn(:,:,1,jpphn) * xthetapn1708 zsurfvar(:,:,1) = trn(:,:,1,jpphn) * xthetapn 1635 1709 #elif defined key_fabm 1636 1710 ! Add all non-diatom surface phytoplankton carbon groups from ERSEM 1637 zsurfvar(:,: ) = trn(:,:,1,jp_fabm_m1+jp_fabm_p2c) + &1638 & trn(:,:,1,jp_fabm_m1+jp_fabm_p3c) + trn(:,:,1,jp_fabm_m1+jp_fabm_p4c)1711 zsurfvar(:,:,1) = trn(:,:,1,jp_fabm_m1+jp_fabm_p2c) + & 1712 & trn(:,:,1,jp_fabm_m1+jp_fabm_p3c) + trn(:,:,1,jp_fabm_m1+jp_fabm_p4c) 1639 1713 #else 1640 1714 CALL ctl_stop( ' Trying to run slphynon observation operator', & … … 1645 1719 CASE('sspm') 1646 1720 #if defined key_spm 1647 zsurfvar(:,: ) = 0.01721 zsurfvar(:,:,1) = 0.0 1648 1722 DO jn = 1, jp_spm 1649 zsurfvar(:,: ) = zsurfvar(:,:) + trn(:,:,1,jn) ! sum SPM sizes1723 zsurfvar(:,:,1) = zsurfvar(:,:,1) + trn(:,:,1,jn) ! sum SPM sizes 1650 1724 END DO 1651 1725 #else … … 1662 1736 & ' but MEDUSA does not explicitly simulate Kd490' ) 1663 1737 #elif defined key_fabm 1664 ! light_xEPS diagnostic variable 1665 fabm_3d(:,:,:) = fabm_get_interior_diagnostic_data(model, jp_fabm_xeps) 1666 zsurfvar(:,:) = fabm_3d(:,:,1) 1738 ! light_Kd_band3 diagnostic variable if using spectral optical model 1739 ! light_xEPS diagnostic variable if using standard ERSEM light model 1740 IF ( jp_fabm_kd490 /= -1 ) THEN 1741 fabm_3d(:,:,:) = model%get_interior_diagnostic_data(jp_fabm_kd490) 1742 ELSEIF ( jp_fabm_xeps /= -1 ) THEN 1743 fabm_3d(:,:,:) = model%get_interior_diagnostic_data(jp_fabm_xeps) 1744 ELSE 1745 CALL ctl_stop( ' Trying to run skd490 observation operator', & 1746 & ' but cannot access Kd490 from ERSEM' ) 1747 ENDIF 1748 zsurfvar(:,:,1) = fabm_3d(:,:,1) 1667 1749 #else 1668 1750 CALL ctl_stop( ' Trying to run skd490 observation operator', & … … 1672 1754 CASE('sfco2') 1673 1755 #if defined key_hadocc 1674 zsurfvar(:,: ) = HADOCC_FCO2(:,:) ! fCO2 from HadOCC1756 zsurfvar(:,:,1) = HADOCC_FCO2(:,:) ! fCO2 from HadOCC 1675 1757 IF ( ( MINVAL( HADOCC_FCO2 ) == HADOCC_FILL_FLT ) .AND. & 1676 1758 & ( MAXVAL( HADOCC_FCO2 ) == HADOCC_FILL_FLT ) ) THEN 1677 1759 zsurfvar(:,:) = obfillflt 1678 zsurfmask(:,: ) = 01760 zsurfmask(:,:,1) = 0 1679 1761 CALL ctl_warn( ' HadOCC fCO2 values masked out for observation operator', & 1680 1762 & ' as HADOCC_FCO2(:,:) == HADOCC_FILL_FLT' ) 1681 1763 ENDIF 1682 1764 #elif defined key_medusa && defined key_roam 1683 zsurfvar(:,: ) = f2_fco2w(:,:)1765 zsurfvar(:,:,1) = f2_fco2w(:,:) 1684 1766 #elif defined key_fabm 1685 1767 ! First, get pCO2 from FABM 1686 fabm_3d(:,:,:) = fabm_get_interior_diagnostic_data(model,jp_fabm_o3pc)1687 zsurfvar(:,: ) = fabm_3d(:,:,1)1768 fabm_3d(:,:,:) = model%get_interior_diagnostic_data(jp_fabm_o3pc) 1769 zsurfvar(:,:,1) = fabm_3d(:,:,1) 1688 1770 ! Now, convert pCO2 to fCO2, based on SST in K. This follows the standard methodology of: 1689 1771 ! Pierrot et al. (2009), Recommendations for autonomous underway pCO2 measuring systems … … 1699 1781 ! because xCO2 in atm is ~0, and so this term will only affect the result to the 3rd decimal 1700 1782 ! place for typical values, and xCO2 would need to be approximated from pCO2 anyway. 1701 zsurfvar(:,: ) = zsurfvar(:,:) * EXP((-1636.75 + &1702 & 12.0408 * (tsn(:,:,1,jp_tem)+rt0) - &1703 & 0.0327957 * (tsn(:,:,1,jp_tem)+rt0)*(tsn(:,:,1,jp_tem)+rt0) + &1704 & 0.0000316528 * (tsn(:,:,1,jp_tem)+rt0)*(tsn(:,:,1,jp_tem)+rt0)*(tsn(:,:,1,jp_tem)+rt0) + &1705 & 2.0 * (57.7 - 0.118 * (tsn(:,:,1,jp_tem)+rt0))) / &1706 & (82.0578 * (tsn(:,:,1,jp_tem)+rt0)))1783 zsurfvar(:,:,1) = zsurfvar(:,:,1) * EXP((-1636.75 + & 1784 & 12.0408 * (tsn(:,:,1,jp_tem)+rt0) - & 1785 & 0.0327957 * (tsn(:,:,1,jp_tem)+rt0)*(tsn(:,:,1,jp_tem)+rt0) + & 1786 & 0.0000316528 * (tsn(:,:,1,jp_tem)+rt0)*(tsn(:,:,1,jp_tem)+rt0)*(tsn(:,:,1,jp_tem)+rt0) + & 1787 & 2.0 * (57.7 - 0.118 * (tsn(:,:,1,jp_tem)+rt0))) / & 1788 & (82.0578 * (tsn(:,:,1,jp_tem)+rt0))) 1707 1789 #else 1708 1790 CALL ctl_stop( ' Trying to run sfco2 observation operator', & … … 1712 1794 CASE('spco2') 1713 1795 #if defined key_hadocc 1714 zsurfvar(:,: ) = HADOCC_PCO2(:,:) ! pCO2 from HadOCC1796 zsurfvar(:,:,1) = HADOCC_PCO2(:,:) ! pCO2 from HadOCC 1715 1797 IF ( ( MINVAL( HADOCC_PCO2 ) == HADOCC_FILL_FLT ) .AND. & 1716 1798 & ( MAXVAL( HADOCC_PCO2 ) == HADOCC_FILL_FLT ) ) THEN 1717 zsurfvar(:,: ) = obfillflt1718 zsurfmask(:,: ) = 01799 zsurfvar(:,:,1) = obfillflt 1800 zsurfmask(:,:,1) = 0 1719 1801 CALL ctl_warn( ' HadOCC pCO2 values masked out for observation operator', & 1720 1802 & ' as HADOCC_PCO2(:,:) == HADOCC_FILL_FLT' ) 1721 1803 ENDIF 1722 1804 #elif defined key_medusa && defined key_roam 1723 zsurfvar(:,: ) = f2_pco2w(:,:)1724 #elif defined key_fabm 1725 fabm_3d(:,:,:) = fabm_get_interior_diagnostic_data(model,jp_fabm_o3pc)1726 zsurfvar(:,: ) = fabm_3d(:,:,1)1805 zsurfvar(:,:,1) = f2_pco2w(:,:) 1806 #elif defined key_fabm 1807 fabm_3d(:,:,:) = model%get_interior_diagnostic_data(jp_fabm_o3pc) 1808 zsurfvar(:,:,1) = fabm_3d(:,:,1) 1727 1809 #else 1728 1810 CALL ctl_stop( ' Trying to run spco2 observation operator', & … … 1739 1821 ! Take the log10 where we can, otherwise exclude 1740 1822 tiny = 1.0e-20 1741 WHERE(zsurfvar(:,: ) > tiny .AND. zsurfvar(:,:) /= obfillflt )1742 zsurfvar(:,: ) = LOG10(zsurfvar(:,:))1823 WHERE(zsurfvar(:,:,1) > tiny .AND. zsurfvar(:,:,1) /= obfillflt ) 1824 zsurfvar(:,:,1) = LOG10(zsurfvar(:,:,1)) 1743 1825 ELSEWHERE 1744 zsurfvar(:,: ) = obfillflt1745 zsurfmask(:,: ) = 01826 zsurfvar(:,:,1) = obfillflt 1827 zsurfmask(:,:,1) = 0 1746 1828 END WHERE 1747 1829 ENDIF 1748 1830 1749 IF ( TRIM(cobstypessurf(jtype)) == 'sla' .AND. & 1750 & ln_time_mean_sla_bkg ) THEN 1751 !Number of time-steps in meaning period 1752 imeanstp = NINT( ( MeanPeriodHours * 60. * 60. ) / rdt ) 1753 CALL obs_surf_opt( surfdataqc(jtype), kstp, jpi, jpj, & 1754 & nit000, idaystp, zsurfvar, & 1755 & zsurfclim, zsurfmask, & 1756 & n2dintsurf(jtype), llnightav(jtype), & 1757 & ravglamscl(jtype), ravgphiscl(jtype), & 1758 & lfpindegs(jtype), kmeanstp = imeanstp ) 1759 1760 1761 ELSE 1762 CALL obs_surf_opt( surfdataqc(jtype), kstp, jpi, jpj, & 1763 & nit000, idaystp, zsurfvar, & 1764 & zsurfclim, zsurfmask, & 1765 & n2dintsurf(jtype), llnightav(jtype), & 1766 & ravglamscl(jtype), ravgphiscl(jtype), & 1767 & lfpindegs(jtype) ) 1768 ENDIF 1831 DO jvar = 1, surfdataqc(jtype)%nvar 1832 1833 IF ( TRIM(cobstypessurf(jtype)) == 'sla' .AND. & 1834 & ln_time_mean_sla_bkg ) THEN 1835 !Number of time-steps in meaning period 1836 imeanstp = NINT( ( MeanPeriodHours * 60. * 60. ) / rdt ) 1837 CALL obs_surf_opt( surfdataqc(jtype), kstp, jpi, jpj, & 1838 & nit000, idaystp, jvar, & 1839 & zsurfvar(:,:,jvar), & 1840 & zsurfclim(:,:,jvar), & 1841 & zsurfmask(:,:,jvar), & 1842 & zglam(:,:,jvar), zgphi(:,:,jvar), & 1843 & n2dintsurf(jtype), llnightav(jtype), & 1844 & ravglamscl(jtype), ravgphiscl(jtype), & 1845 & lfpindegs(jtype), kmeanstp = imeanstp ) 1846 1847 ELSE 1848 CALL obs_surf_opt( surfdataqc(jtype), kstp, jpi, jpj, & 1849 & nit000, idaystp, jvar, & 1850 & zsurfvar(:,:,jvar), & 1851 & zsurfclim(:,:,jvar), & 1852 & zsurfmask(:,:,jvar), & 1853 & zglam(:,:,jvar), zgphi(:,:,jvar), & 1854 & n2dintsurf(jtype), llnightav(jtype), & 1855 & ravglamscl(jtype), ravgphiscl(jtype), & 1856 & lfpindegs(jtype) ) 1857 ENDIF 1858 1859 END DO 1860 1861 CALL wrk_dealloc( jpi, jpj, surfdataqc(jtype)%nvar, zsurfvar ) 1862 CALL wrk_dealloc( jpi, jpj, surfdataqc(jtype)%nvar, zsurfclim ) 1863 CALL wrk_dealloc( jpi, jpj, surfdataqc(jtype)%nvar, zsurfmask ) 1864 CALL wrk_dealloc( jpi, jpj, surfdataqc(jtype)%nvar, zglam ) 1865 CALL wrk_dealloc( jpi, jpj, surfdataqc(jtype)%nvar, zgphi ) 1769 1866 1770 1867 END DO 1771 1772 CALL wrk_dealloc( jpi, jpj, zsurfvar )1773 CALL wrk_dealloc( jpi, jpj, zsurfmask )1774 1868 #if defined key_fabm 1775 1869 CALL wrk_dealloc( jpi, jpj, jpk, fabm_3d ) … … 1827 1921 & ) 1828 1922 1829 CALL obs_rotvel ( profdataqc(jtype), nn_2dint_default, zu, zv )1923 CALL obs_rotvel_pro( profdataqc(jtype), nn_2dint_default, zu, zv ) 1830 1924 1831 1925 DO jo = 1, profdataqc(jtype)%nprof … … 1860 1954 1861 1955 DO jtype = 1, nsurftypes 1956 1957 IF ( TRIM(cobstypessurf(jtype)) == 'vel' ) THEN 1958 1959 ! For velocity data, rotate the model velocities to N/S, E/W 1960 ! using the compressed data structure. 1961 ALLOCATE( & 1962 & zu(surfdataqc(jtype)%nsurf), & 1963 & zv(surfdataqc(jtype)%nsurf) & 1964 & ) 1965 1966 CALL obs_rotvel_surf( surfdataqc(jtype), nn_2dint_default, zu, zv ) 1967 1968 DO jo = 1, surfdataqc(jtype)%nsurf 1969 surfdataqc(jtype)%rmod(jo,1) = zu(jo) 1970 surfdataqc(jtype)%rmod(jo,2) = zv(jo) 1971 END DO 1972 1973 DEALLOCATE( zu ) 1974 DEALLOCATE( zv ) 1975 1976 END IF 1977 1862 1978 1863 1979 CALL obs_surf_decompress( surfdataqc(jtype), &
Note: See TracChangeset
for help on using the changeset viewer.
