Changeset 6990
 Timestamp:
 20161005T11: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, & !: ith grid coord. for interpolating to surface observation 57 58 & mj, & !: jth 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.