Changeset 6990
- Timestamp:
- 2016-10-05T11:18:51+02:00 (8 years ago)
- Location:
- branches/UKMO/dev_r4650_general_vert_coord_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r4650_general_vert_coord_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
r6406 r6990 171 171 & ln_sla, ln_sladt, ln_slafb, & 172 172 & ln_ssh, ln_sst, ln_sstfb, ln_sss, ln_nea, & 173 & ln_bound_reject, & 173 174 & enactfiles, coriofiles, profbfiles, & 174 175 & slafilesact, slafilespas, slafbfiles, & … … 244 245 ln_velfb_av(:) = .FALSE. 245 246 ln_ignmis = .FALSE. 247 ln_bound_reject = .TRUE. 246 248 247 249 ! Read Namelist namobs : control observation diagnostics … … 469 471 WRITE(numout,*) ' Type of horizontal interpolation method n2dint = ', n2dint 470 472 WRITE(numout,*) ' Rejection of observations near land swithch ln_nea = ', ln_nea 473 WRITE(numout,*) ' Rejection of obs near open bdys ln_bound_reject = ', ln_bound_reject 471 474 WRITE(numout,*) ' MSSH correction scheme nmsshc = ', nmsshc 472 475 WRITE(numout,*) ' MDT correction mdtcorr = ', mdtcorr -
branches/UKMO/dev_r4650_general_vert_coord_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90
r6301 r6990 27 27 USE obs_inter_sup ! Interpolation support 28 28 USE obs_oper ! Observation operators 29 #if defined key_bdy 30 USE bdy_oce, ONLY : & ! Boundary information 31 idx_bdy, nb_bdy 32 #endif 29 33 USE lib_mpp, ONLY : & 30 34 & ctl_warn, ctl_stop … … 43 47 & calc_month_len ! Calculate the number of days in the months of a year 44 48 49 LOGICAL, PUBLIC :: ln_bound_reject !: Remove obs near open boundaries 50 45 51 !!---------------------------------------------------------------------- 46 52 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 79 85 & gphit, & 80 86 & gdept_1d,& 81 & tmask 87 #if defined key_vvl 88 & gdepw_n, & 89 & gdept_n, & 90 #else 91 & gdepw_1d, & 92 & gdept_1d, & 93 #endif 94 & tmask, & 95 & ln_zco, & 96 & ln_zps, & 97 & nproc 82 98 !! * Arguments 83 99 TYPE(obs_prof), INTENT(INOUT) :: profdata ! Full set of profile data … … 101 117 INTEGER :: ilantobs ! - within a model land cell (temperature) 102 118 INTEGER :: ilansobs ! - within a model land cell (salinity) 119 INTEGER :: ibdytobs ! - boundary (temperature) 120 INTEGER :: ibdysobs ! - boundary (salinity) 103 121 INTEGER :: inlatobs ! - close to land (temperature) 104 122 INTEGER :: inlasobs ! - close to land (salinity) … … 110 128 INTEGER :: ilantobsmpp ! - within a model land cell (temperature) 111 129 INTEGER :: ilansobsmpp ! - within a model land cell (salinity) 130 INTEGER :: ibdytobsmpp ! - boundary (temperature) 131 INTEGER :: ibdysobsmpp ! - boundary (salinity) 112 132 INTEGER :: inlatobsmpp ! - close to land (temperature) 113 133 INTEGER :: inlasobsmpp ! - close to land (salinity) … … 142 162 inlatobs = 0 143 163 inlasobs = 0 164 ibdytobs = 0 165 ibdysobs = 0 144 166 145 167 ! ----------------------------------------------------------------------- … … 198 220 & profdata%nqc, profdata%var(1)%nvqc, & 199 221 & iosdtobs, ilantobs, & 200 & inlatobs, ld_nea ) 222 & inlatobs, ld_nea, & 223 & ibdytobs, ln_bound_reject ) 224 201 225 202 226 CALL obs_mpp_sum_integer( iosdtobs, iosdtobsmpp ) 203 227 CALL obs_mpp_sum_integer( ilantobs, ilantobsmpp ) 204 228 CALL obs_mpp_sum_integer( inlatobs, inlatobsmpp ) 229 CALL obs_mpp_sum_integer( ibdytobs, ibdytobsmpp ) 205 230 206 231 ! Salinity … … 218 243 & profdata%nqc, profdata%var(2)%nvqc, & 219 244 & iosdsobs, ilansobs, & 220 & inlasobs, ld_nea ) 245 & inlasobs, ld_nea, & 246 & ibdysobs, ln_bound_reject ) 221 247 222 248 CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 223 249 CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 224 250 CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 251 CALL obs_mpp_sum_integer( ibdysobs, ibdysobsmpp ) 225 252 226 253 ! ----------------------------------------------------------------------- … … 280 307 & inlatobsmpp 281 308 ENDIF 309 WRITE(numout,*) ' Remaining T data near open boundary (removed) = ',& 310 & ibdytobsmpp 282 311 WRITE(numout,*) ' T data accepted = ', & 283 312 & prodatqc%nvprotmpp(1) … … 293 322 & inlasobsmpp 294 323 ENDIF 324 WRITE(numout,*) ' Remaining S data near open boundary (removed) = ',& 325 & ibdysobsmpp 295 326 WRITE(numout,*) ' S data accepted = ', & 296 327 & prodatqc%nvprotmpp(2) … … 380 411 INTEGER :: inlasobs ! - close to land 381 412 INTEGER :: igrdobs ! - fail the grid search 413 INTEGER :: ibdysobs ! - close to open boundary 382 414 ! Global counters for observations that 383 415 INTEGER :: iotdobsmpp ! - outside time domain … … 386 418 INTEGER :: inlasobsmpp ! - close to land 387 419 INTEGER :: igrdobsmpp ! - fail the grid search 420 INTEGER :: ibdysobsmpp ! - close to open boundary 388 421 LOGICAL, DIMENSION(:), ALLOCATABLE :: & 389 422 & llvalid ! SLA data selection … … 391 424 INTEGER :: jstp ! Time loop variable 392 425 INTEGER :: inrc ! Time index variable 426 INTEGER :: irec ! Record index 393 427 394 428 IF(lwp) WRITE(numout,*)'obs_pre_sla : Preparing the SLA observations...' … … 410 444 ilansobs = 0 411 445 inlasobs = 0 446 ibdysobs = 0 412 447 413 448 ! ----------------------------------------------------------------------- … … 443 478 & tmask(:,:,1), sladata%nqc, & 444 479 & iosdsobs, ilansobs, & 445 & inlasobs, ld_nea ) 480 & inlasobs, ld_nea, & 481 & ibdysobs, ln_bound_reject ) 446 482 447 483 CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 448 484 CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 449 485 CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 486 CALL obs_mpp_sum_integer( ibdysobs, ibdysobsmpp ) 450 487 451 488 ! ----------------------------------------------------------------------- … … 496 533 & inlasobsmpp 497 534 ENDIF 535 WRITE(numout,*) ' Remaining SLA data near open boundary (removed) = ', & 536 & ibdysobsmpp 498 537 WRITE(numout,*) ' SLA data accepted = ', & 499 538 & sladatqc%nsurfmpp … … 521 560 ENDIF 522 561 562 !--------------------------------------------------------- 563 ! Record handling 564 !--------------------------------------------------------- 565 ! First count the number of records 566 sladatqc%nrec = 0 567 DO jstp = nit000 - 1, nitend 568 inrc = jstp - nit000 + 2 569 IF ( sladatqc%nsstpmpp(inrc) > 0 ) THEN 570 sladatqc%nrec = sladatqc%nrec + 1 571 ENDIF 572 END DO 573 ! Allocate record data 574 ALLOCATE( & 575 & sladatqc%mrecstp(sladatqc%nrec) & 576 & ) 577 ! Finally save the time step corresponding to record rank 578 irec = 0 579 DO jstp = nit000 - 1, nitend 580 inrc = jstp - nit000 + 2 581 IF ( sladatqc%nsstpmpp(inrc) > 0 ) THEN 582 irec = irec + 1 583 sladatqc%mrecstp(irec) = inrc 584 ENDIF 585 IF ( lwp ) THEN 586 WRITE(numout,1999) inrc, sladatqc%nsstpmpp(inrc) 587 ENDIF 588 END DO 589 590 ! Print record information 591 IF( lwp ) THEN 592 WRITE(numout,*) 593 WRITE(numout,2000) 594 WRITE(numout,2001) 595 DO irec = 1, sladatqc%nrec 596 WRITE(numout,1999) irec, sladatqc%mrecstp(irec) 597 END DO 598 ENDIF 599 600 523 601 1997 FORMAT(10X,'Time step',5X,'Sea level anomaly') 524 602 1998 FORMAT(10X,'---------',5X,'-----------------') 525 603 1999 FORMAT(10X,I9,5X,I17) 604 2000 FORMAT(15X,'Record',10X,'Time step') 605 2001 FORMAT(15X,'------',10X,'---------') 526 606 527 607 END SUBROUTINE obs_pre_sla … … 567 647 INTEGER :: inlasobs ! - close to land 568 648 INTEGER :: igrdobs ! - fail the grid search 649 INTEGER :: ibdysobs ! - close to open boundary 569 650 ! Global counters for observations that 570 651 INTEGER :: iotdobsmpp ! - outside time domain … … 573 654 INTEGER :: inlasobsmpp ! - close to land 574 655 INTEGER :: igrdobsmpp ! - fail the grid search 656 INTEGER :: ibdysobsmpp ! - close to open boundary 575 657 LOGICAL, DIMENSION(:), ALLOCATABLE :: & 576 658 & llvalid ! SST data selection … … 578 660 INTEGER :: jstp ! Time loop variable 579 661 INTEGER :: inrc ! Time index variable 662 INTEGER :: irec ! Record index 580 663 581 664 IF(lwp) WRITE(numout,*)'obs_pre_sst : Preparing the SST observations...' … … 597 680 ilansobs = 0 598 681 inlasobs = 0 682 ibdysobs = 0 599 683 600 684 ! ----------------------------------------------------------------------- … … 627 711 & tmask(:,:,1), sstdata%nqc, & 628 712 & iosdsobs, ilansobs, & 629 & inlasobs, ld_nea ) 713 & inlasobs, ld_nea, & 714 & ibdysobs, ln_bound_reject ) 630 715 631 716 CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 632 717 CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 633 718 CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 719 CALL obs_mpp_sum_integer( ibdysobs, ibdysobsmpp ) 634 720 635 721 ! ----------------------------------------------------------------------- … … 680 766 & inlasobsmpp 681 767 ENDIF 768 WRITE(numout,*) ' Remaining SST data near open boundary (removed) = ', & 769 & ibdysobsmpp 682 770 WRITE(numout,*) ' SST data accepted = ', & 683 771 & sstdatqc%nsurfmpp … … 705 793 ENDIF 706 794 795 !--------------------------------------------------------- 796 ! Record handling 797 !--------------------------------------------------------- 798 ! First count the number of records 799 sstdatqc%nrec = 0 800 DO jstp = nit000 - 1, nitend 801 inrc = jstp - nit000 + 2 802 IF ( sstdatqc%nsstpmpp(inrc) > 0 ) THEN 803 sstdatqc%nrec = sstdatqc%nrec + 1 804 ENDIF 805 END DO 806 ! Allocate record data 807 ALLOCATE( & 808 & sstdatqc%mrecstp(sstdatqc%nrec) & 809 & ) 810 ! Finally save the time step corresponding to record rank 811 irec = 0 812 DO jstp = nit000 - 1, nitend 813 inrc = jstp - nit000 + 2 814 IF ( sstdatqc%nsstpmpp(inrc) > 0 ) THEN 815 irec = irec + 1 816 sstdatqc%mrecstp(irec) = inrc 817 ENDIF 818 IF ( lwp ) THEN 819 WRITE(numout,1999) jstp, sstdatqc%nsstpmpp(inrc) 820 ENDIF 821 END DO 822 823 ! Print record information 824 IF( lwp ) THEN 825 WRITE(numout,*) 826 WRITE(numout,2000) 827 WRITE(numout,2001) 828 DO irec = 1, sstdatqc%nrec 829 WRITE(numout,1999) irec, sstdatqc%mrecstp(irec) - 1 830 END DO 831 ENDIF 832 707 833 1997 FORMAT(10X,'Time step',5X,'Sea surface temperature') 708 834 1998 FORMAT(10X,'---------',5X,'-----------------') 709 835 1999 FORMAT(10X,I9,5X,I17) 836 2000 FORMAT(15X,'Record',10X,'Time step') 837 2001 FORMAT(15X,'------',10X,'---------') 710 838 711 839 END SUBROUTINE obs_pre_sst … … 751 879 INTEGER :: inlasobs ! - close to land 752 880 INTEGER :: igrdobs ! - fail the grid search 881 INTEGER :: ibdysobs ! - close to open boundary 753 882 ! Global counters for observations that 754 883 INTEGER :: iotdobsmpp ! - outside time domain … … 757 886 INTEGER :: inlasobsmpp ! - close to land 758 887 INTEGER :: igrdobsmpp ! - fail the grid search 888 INTEGER :: ibdysobsmpp ! - close to open boundary 759 889 LOGICAL, DIMENSION(:), ALLOCATABLE :: & 760 890 & llvalid ! data selection … … 762 892 INTEGER :: jstp ! Time loop variable 763 893 INTEGER :: inrc ! Time index variable 894 INTEGER :: irec ! Record index 764 895 765 896 IF (lwp) WRITE(numout,*)'obs_pre_seaice : Preparing the sea ice observations...' … … 781 912 ilansobs = 0 782 913 inlasobs = 0 914 ibdysobs = 0 783 915 784 916 ! ----------------------------------------------------------------------- … … 811 943 & tmask(:,:,1), seaicedata%nqc, & 812 944 & iosdsobs, ilansobs, & 813 & inlasobs, ld_nea ) 945 & inlasobs, ld_nea, & 946 & ibdysobs, ln_bound_reject ) 814 947 815 948 CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 816 949 CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 817 950 CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 951 CALL obs_mpp_sum_integer( ibdysobs, ibdysobsmpp ) 818 952 819 953 ! ----------------------------------------------------------------------- … … 864 998 & inlasobsmpp 865 999 ENDIF 1000 WRITE(numout,*) ' Remaining sea ice data near open boundary (removed) = ', & 1001 & ibdysobsmpp 866 1002 WRITE(numout,*) ' Sea ice data accepted = ', & 867 1003 & seaicedatqc%nsurfmpp … … 889 1025 ENDIF 890 1026 1027 !--------------------------------------------------------- 1028 ! Record handling 1029 !--------------------------------------------------------- 1030 ! First count the number of records 1031 seaicedatqc%nrec = 0 1032 DO jstp = nit000 - 1, nitend 1033 inrc = jstp - nit000 + 2 1034 IF ( seaicedatqc%nsstpmpp(inrc) > 0 ) THEN 1035 seaicedatqc%nrec = seaicedatqc%nrec + 1 1036 ENDIF 1037 END DO 1038 ! Allocate record data 1039 ALLOCATE( & 1040 & seaicedatqc%mrecstp(seaicedatqc%nrec) & 1041 & ) 1042 ! Finally save the time step corresponding to record rank 1043 irec = 0 1044 DO jstp = nit000 - 1, nitend 1045 inrc = jstp - nit000 + 2 1046 IF ( seaicedatqc%nsstpmpp(inrc) > 0 ) THEN 1047 irec = irec + 1 1048 seaicedatqc%mrecstp(irec) = inrc 1049 ENDIF 1050 IF ( lwp ) THEN 1051 WRITE(numout,1999) inrc, seaicedatqc%nsstpmpp(inrc) 1052 ENDIF 1053 END DO 1054 1055 ! Print record information 1056 IF( lwp ) THEN 1057 WRITE(numout,*) 1058 WRITE(numout,2000) 1059 WRITE(numout,2001) 1060 DO irec = 1, seaicedatqc%nrec 1061 WRITE(numout,1999) irec, seaicedatqc%mrecstp(irec) 1062 END DO 1063 ENDIF 1064 891 1065 1997 FORMAT(10X,'Time step',5X,'Sea ice data ') 892 1066 1998 FORMAT(10X,'---------',5X,'-----------------') 893 1067 1999 FORMAT(10X,I9,5X,I17) 1068 2000 FORMAT(15X,'Record',10X,'Time step') 1069 2001 FORMAT(15X,'------',10X,'---------') 894 1070 895 1071 END SUBROUTINE obs_pre_seaice … … 939 1115 INTEGER :: inlavobs ! - close to land (meridional velocity component) 940 1116 INTEGER :: igrdobs ! - fail the grid search 1117 INTEGER :: ibdyuobs ! - close to open boundary 1118 INTEGER :: ibdyvobs ! - close to open boundary 941 1119 INTEGER :: iuvchku ! - reject u if v rejected and vice versa 942 1120 INTEGER :: iuvchkv ! … … 950 1128 INTEGER :: inlavobsmpp ! - close to land (meridional velocity component) 951 1129 INTEGER :: igrdobsmpp ! - fail the grid search 1130 INTEGER :: ibdyuobsmpp ! - close to open boundary 1131 INTEGER :: ibdyvobsmpp ! - close to open boundary 952 1132 INTEGER :: iuvchkumpp ! - reject u if v rejected and vice versa 953 1133 INTEGER :: iuvchkvmpp ! … … 981 1161 inlauobs = 0 982 1162 inlavobs = 0 1163 ibdyuobs = 0 1164 ibdyvobs = 0 983 1165 iuvchku = 0 984 1166 iuvchkv = 0 … … 1033 1215 & profdata%nqc, profdata%var(1)%nvqc, & 1034 1216 & iosduobs, ilanuobs, & 1035 & inlauobs, ld_nea ) 1217 & inlauobs, ld_nea, & 1218 & ibdyuobs, ln_bound_reject ) 1036 1219 1037 1220 CALL obs_mpp_sum_integer( iosduobs, iosduobsmpp ) 1038 1221 CALL obs_mpp_sum_integer( ilanuobs, ilanuobsmpp ) 1039 1222 CALL obs_mpp_sum_integer( inlauobs, inlauobsmpp ) 1223 CALL obs_mpp_sum_integer( ibdyuobs, ibdyuobsmpp ) 1040 1224 1041 1225 ! Meridional Velocity Component … … 1053 1237 & profdata%nqc, profdata%var(2)%nvqc, & 1054 1238 & iosdvobs, ilanvobs, & 1055 & inlavobs, ld_nea ) 1239 & inlavobs, ld_nea, & 1240 & ibdyvobs, ln_bound_reject ) 1056 1241 1057 1242 CALL obs_mpp_sum_integer( iosdvobs, iosdvobsmpp ) 1058 1243 CALL obs_mpp_sum_integer( ilanvobs, ilanvobsmpp ) 1059 1244 CALL obs_mpp_sum_integer( inlavobs, inlavobsmpp ) 1245 CALL obs_mpp_sum_integer( ibdyvobs, ibdyvobsmpp ) 1060 1246 1061 1247 ! ----------------------------------------------------------------------- … … 1123 1309 & inlauobsmpp 1124 1310 ENDIF 1311 WRITE(numout,*) ' Remaining U data near open boundary (removed) = ', & 1312 & ibdyuobsmpp 1125 1313 WRITE(numout,*) ' U observation rejected since V rejected = ', & 1126 1314 & iuvchku … … 1138 1326 & inlavobsmpp 1139 1327 ENDIF 1328 WRITE(numout,*) ' Remaining V data near open boundary (removed) = ', & 1329 & ibdyvobsmpp 1140 1330 WRITE(numout,*) ' V observation rejected since U rejected = ', & 1141 1331 & iuvchkv … … 1530 1720 & plam, pphi, pmask, & 1531 1721 & kobsqc, kosdobs, klanobs, & 1532 & knlaobs,ld_nea ) 1722 & knlaobs,ld_nea, & 1723 & kbdyobs,ld_bound_reject ) 1533 1724 !!---------------------------------------------------------------------- 1534 1725 !! *** ROUTINE obs_coo_spc_2d *** … … 1566 1757 INTEGER, INTENT(INOUT) :: klanobs ! Observations within a model land cell 1567 1758 INTEGER, INTENT(INOUT) :: knlaobs ! Observations near land 1759 INTEGER, INTENT(INOUT) :: kbdyobs ! Observations near boundary 1568 1760 LOGICAL, INTENT(IN) :: ld_nea ! Flag observations near land 1761 LOGICAL, INTENT(IN) :: ld_bound_reject ! Flag observations near open boundary 1569 1762 !! * Local declarations 1570 1763 REAL(KIND=wp), DIMENSION(2,2,kobsno) :: & 1571 1764 & zgmsk ! Grid mask 1765 #if defined key_bdy 1766 REAL(KIND=wp), DIMENSION(2,2,kobsno) :: & 1767 & zbmsk ! Boundary mask 1768 REAL(KIND=wp), DIMENSION(jpi,jpj) :: zbdymask 1769 #endif 1572 1770 REAL(KIND=wp), DIMENSION(2,2,kobsno) :: & 1573 1771 & zglam, & ! Model longitude at grid points … … 1611 1809 1612 1810 END DO 1811 1812 #if defined key_bdy 1813 ! Create a mask grid points in boundary rim 1814 IF (ld_bound_reject) THEN 1815 zbdymask(:,:) = 1.0_wp 1816 DO ji = 1, nb_bdy 1817 DO jj = 1, idx_bdy(ji)%nblen(1) 1818 zbdymask(idx_bdy(ji)%nbi(jj,1),idx_bdy(ji)%nbj(jj,1)) = 0.0_wp 1819 ENDDO 1820 ENDDO 1821 1822 CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, zbdymask, zbmsk ) 1823 ENDIF 1824 #endif 1613 1825 1614 1826 CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, pmask, zgmsk ) … … 1656 1868 END DO 1657 1869 1658 ! For observations on the grid reject them if their are at 1659 ! a masked point 1660 1661 IF (lgridobs) THEN 1662 IF (zgmsk(iig,ijg,jobs) == 0.0_wp ) THEN 1663 kobsqc(jobs) = kobsqc(jobs) + 12 1664 klanobs = klanobs + 1 1870 ! Flag if the observation falls is close to land 1871 IF ( MINVAL( zgmsk(1:2,1:2,jobs) ) == 0.0_wp) THEN 1872 knlaobs = knlaobs + 1 1873 IF (ld_nea) THEN 1874 kobsqc(jobs) = kobsqc(jobs) + 14 1665 1875 CYCLE 1666 1876 ENDIF 1667 1877 ENDIF 1668 1669 ! Flag if the observation falls is close to land 1670 IF ( MINVAL( zgmsk(1:2,1:2,jobs) ) == 0.0_wp) THEN 1671 IF (ld_nea) kobsqc(jobs) = kobsqc(jobs) + 14 1672 knlaobs = knlaobs + 1 1673 CYCLE 1674 ENDIF 1878 1879 #if defined key_bdy 1880 ! Flag if the observation falls close to the boundary rim 1881 IF (ld_bound_reject) THEN 1882 IF ( MINVAL( zbmsk(1:2,1:2,jobs) ) == 0.0_wp ) THEN 1883 kobsqc(jobs) = kobsqc(jobs) + 15 1884 kbdyobs = kbdyobs + 1 1885 CYCLE 1886 ENDIF 1887 ! for observations on the grid... 1888 IF (lgridobs) THEN 1889 IF (zbmsk(iig,ijg,jobs) == 0.0_wp ) THEN 1890 kobsqc(jobs) = kobsqc(jobs) + 15 1891 kbdyobs = kbdyobs + 1 1892 CYCLE 1893 ENDIF 1894 ENDIF 1895 ENDIF 1896 #endif 1675 1897 1676 1898 END DO … … 1684 1906 & plam, pphi, pdep, pmask, & 1685 1907 & kpobsqc, kobsqc, kosdobs, & 1686 & klanobs, knlaobs, ld_nea ) 1908 & klanobs, knlaobs, ld_nea, & 1909 & kbdyobs, ld_bound_reject ) 1687 1910 !!---------------------------------------------------------------------- 1688 1911 !! *** ROUTINE obs_coo_spc_3d *** … … 1749 1972 INTEGER, INTENT(INOUT) :: klanobs ! Observations within a model land cell 1750 1973 INTEGER, INTENT(INOUT) :: knlaobs ! Observations near land 1974 INTEGER, INTENT(INOUT) :: kbdyobs ! Observations near boundary 1751 1975 LOGICAL, INTENT(IN) :: ld_nea ! Flag observations near land 1976 LOGICAL, INTENT(IN) :: ld_bound_reject ! Flag observations near open boundary 1752 1977 !! * Local declarations 1753 1978 REAL(KIND=wp), DIMENSION(2,2,kpk,kprofno) :: & 1754 1979 & zgmsk ! Grid mask 1980 #if defined key_bdy 1981 REAL(KIND=wp), DIMENSION(2,2,kprofno) :: & 1982 & zbmsk ! Boundary mask 1983 REAL(KIND=wp), DIMENSION(jpi,jpj) :: zbdymask 1984 #endif 1755 1985 REAL(KIND=wp), DIMENSION(2,2,kpk,kprofno) :: & 1756 1986 & zgdepw … … 1797 2027 1798 2028 END DO 2029 2030 #if defined key_bdy 2031 ! Create a mask grid points in boundary rim 2032 IF (ld_bound_reject) THEN 2033 zbdymask(:,:) = 1.0_wp 2034 DO ji = 1, nb_bdy 2035 DO jj = 1, idx_bdy(ji)%nblen(1) 2036 zbdymask(idx_bdy(ji)%nbi(jj,1),idx_bdy(ji)%nbj(jj,1)) = 0.0_wp 2037 ENDDO 2038 ENDDO 2039 ENDIF 2040 2041 CALL obs_int_comm_2d( 2, 2, kprofno, igrdi, igrdj, zbdymask, zbmsk ) 2042 #endif 1799 2043 1800 2044 CALL obs_int_comm_3d( 2, 2, kprofno, kpk, igrdi, igrdj, pmask, zgmsk ) … … 1876 2120 1877 2121 ELSE ! Case 2 1878 1879 2122 ! Flag if the observation is deeper than the bathymetry 1880 2123 ! Or if it is within the mask … … 1908 2151 ENDIF 1909 2152 ENDIF 1910 1911 ! Flag if the observation falls is close to land 1912 IF ( MINVAL( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) == & 1913 & 0.0_wp) THEN 1914 IF (ld_nea) kobsqc(jobsp) = kobsqc(jobsp) + 14 1915 knlaobs = knlaobs + 1 1916 ENDIF 1917 2153 1918 2154 ! Set observation depth equal to that of the first model depth 1919 2155 IF ( pobsdep(jobsp) <= pdep(1) ) THEN 1920 2156 pobsdep(jobsp) = pdep(1) 1921 2157 ENDIF 2158 2159 #if defined key_bdy 2160 ! Flag if the observation falls close to the boundary rim 2161 IF (ld_bound_reject) THEN 2162 IF ( MINVAL( zbmsk(1:2,1:2,jobs) ) == 0.0_wp ) THEN 2163 kobsqc(jobsp) = kobsqc(jobsp) + 15 2164 kbdyobs = kbdyobs + 1 2165 CYCLE 2166 ENDIF 2167 ! for observations on the grid... 2168 IF (lgridobs) THEN 2169 IF (zbmsk(iig,ijg,jobs) == 0.0_wp ) THEN 2170 kobsqc(jobsp) = kobsqc(jobsp) + 15 2171 kbdyobs = kbdyobs + 1 2172 CYCLE 2173 ENDIF 2174 ENDIF 2175 ENDIF 2176 #endif 1922 2177 1923 2178 END DO -
branches/UKMO/dev_r4650_general_vert_coord_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_surf_def.F90
r5838 r6990 50 50 INTEGER :: npj 51 51 INTEGER :: nsurfup !: Observation counter used in obs_oper 52 INTEGER :: nrec !: Number of surface observation records in window 52 53 53 54 ! Arrays with size equal to the number of surface observations … … 56 57 & mi, & !: i-th grid coord. for interpolating to surface observation 57 58 & mj, & !: j-th grid coord. for interpolating to surface observation 59 & mt, & !: time record number for gridded data 58 60 & nsidx,& !: Surface observation number 59 61 & nsfil,& !: Surface observation number in file … … 90 92 & nsstpmpp !: Global number of surface observations per time step 91 93 94 ! Arrays with size equal to the number of observation records in the window 95 INTEGER, POINTER, DIMENSION(:) :: & 96 & mrecstp ! Time step of the records 97 92 98 ! Arrays used to store source indices when 93 99 ! compressing obs_surf derived types … … 97 103 INTEGER, POINTER, DIMENSION(:) :: & 98 104 & nsind !: Source indices of surface data in compressed data 105 106 ! Is this a gridded product? 107 108 LOGICAL :: lgrid 99 109 100 110 END TYPE obs_surf … … 146 156 & surf%mi(ksurf), & 147 157 & surf%mj(ksurf), & 158 & surf%mt(ksurf), & 148 159 & surf%nsidx(ksurf), & 149 160 & surf%nsfil(ksurf), & … … 162 173 & ) 163 174 175 surf%mt(:) = -1 176 164 177 165 178 ! Allocate arrays of number of surface data size * number of variables … … 176 189 & ) 177 190 191 surf%rext(:,:) = 0.0_wp 192 178 193 ! Allocate arrays of number of time step size 179 194 … … 203 218 204 219 surf%nsurfup = 0 220 221 ! Not gridded by default 222 223 surf%lgrid = .FALSE. 205 224 206 225 END SUBROUTINE obs_surf_alloc … … 228 247 & surf%mi, & 229 248 & surf%mj, & 249 & surf%mt, & 230 250 & surf%nsidx, & 231 251 & surf%nsfil, & … … 350 370 newsurf%mi(insurf) = surf%mi(ji) 351 371 newsurf%mj(insurf) = surf%mj(ji) 372 newsurf%mt(insurf) = surf%mt(ji) 352 373 newsurf%nsidx(insurf) = surf%nsidx(ji) 353 374 newsurf%nsfil(insurf) = surf%nsfil(ji) … … 393 414 394 415 newsurf%nstp = surf%nstp 416 417 ! Set gridded stuff 418 419 newsurf%mt(insurf) = surf%mt(ji) 395 420 396 421 ! Deallocate temporary data … … 433 458 oldsurf%mi(jj) = surf%mi(ji) 434 459 oldsurf%mj(jj) = surf%mj(ji) 460 oldsurf%mt(jj) = surf%mt(ji) 435 461 oldsurf%nsidx(jj) = surf%nsidx(ji) 436 462 oldsurf%nsfil(jj) = surf%nsfil(ji)
Note: See TracChangeset
for help on using the changeset viewer.