- Timestamp:
- 2019-08-23T10:37:22+02:00 (5 years ago)
- Location:
- branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM
- Files:
-
- 9 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM/CONFIG/SHARED/namelist_ref
r9306 r11468 1232 1232 ln_s_at_t = .false. ! Logical switch for computing model S at T obs if not there 1233 1233 ln_sstnight = .false. ! Logical switch for calculating night-time average for SST obs 1234 ln_output_clim = .false. ! Logical switch for writing climatological values to fdbk files 1234 1235 ln_default_fp_indegs = .true. ! Logical: T=> averaging footprint is in degrees, F=> in metres 1235 1236 ln_sla_fp_indegs = .true. ! Logical: T=> averaging footprint is in degrees, F=> in metres -
branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
r11235 r11468 33 33 USE mpp_map ! MPP mapping 34 34 USE lib_mpp ! For ctl_warn/stop 35 USE tradmp ! For climatological temperature & salinity 35 36 36 37 IMPLICIT NONE … … 53 54 LOGICAL :: ln_sss_fp_indegs !: T=> SSS obs footprint size specified in degrees, F=> in metres 54 55 LOGICAL :: ln_sic_fp_indegs !: T=> sea-ice obs footprint size specified in degrees, F=> in metres 56 LOGICAL :: ln_output_clim !: Logical switch for interpolating and writing T/S climatology 55 57 56 58 REAL(wp) :: rn_default_avglamscl !: Default E/W diameter of observation footprint … … 232 234 LOGICAL :: ltype_fp_indegs ! Local version of ln_*_fp_indegs 233 235 LOGICAL :: ltype_night ! Local version of ln_sstnight (false for other variables) 236 LOGICAL :: ltype_clim ! Local version of ln_output_clim 234 237 235 238 REAL(wp), POINTER, DIMENSION(:,:,:) :: & … … 254 257 & ln_grid_global, ln_grid_search_lookup, & 255 258 & ln_ignmis, ln_s_at_t, ln_bound_reject, & 256 & ln_sstnight, ln_default_fp_indegs, & 259 & ln_sstnight, ln_output_clim, & 260 & ln_default_fp_indegs, & 257 261 & ln_sla_fp_indegs, ln_sst_fp_indegs, & 258 262 & ln_sss_fp_indegs, ln_sic_fp_indegs, & … … 415 419 WRITE(numout,*) ' Daily average types nn_profdavtypes = ', nn_profdavtypes 416 420 WRITE(numout,*) ' Logical switch for night-time SST obs ln_sstnight = ', ln_sstnight 421 WRITE(numout,*) ' Logical switch for writing climat. at obs points ln_output_clim = ', ln_output_clim 417 422 ENDIF 418 423 !----------------------------------------------------------------------- … … 438 443 RETURN 439 444 ENDIF 445 446 IF ( ln_output_clim .AND. ( .NOT. ln_tradmp ) ) THEN 447 IF(lwp) WRITE(numout,cform_war) 448 IF(lwp) WRITE(numout,*) ' ln_output_clim is true, but ln_tradmp is false', & 449 & ' so climatological T/S not available and will not be output' 450 nwarn = nwarn + 1 451 ln_output_clim = .FALSE. 452 ENDIF 453 440 454 441 455 IF(lwp) WRITE(numout,*) ' Number of profile obs types: ',nproftypes … … 714 728 715 729 DO jtype = 1, nproftypes 716 730 731 ltype_clim = .FALSE. 732 717 733 IF ( TRIM(cobstypesprof(jtype)) == 'prof' ) THEN 718 734 nvarsprof(jtype) = 2 719 735 nextrprof(jtype) = 1 736 IF ( ln_output_clim ) ltype_clim = .TRUE. 720 737 ALLOCATE(llvar(nvarsprof(jtype))) 721 738 CALL wrk_alloc( jpi, jpj, nvarsprof(jtype), zglam ) … … 763 780 & nvarsprof(jtype), nextrprof(jtype), nitend-nit000+2, & 764 781 & rn_dobsini, rn_dobsend, llvar, & 765 & ln_ignmis, ln_s_at_t, .FALSE., &782 & ln_ignmis, ln_s_at_t, .FALSE., ltype_clim, & 766 783 & kdailyavtypes = nn_profdavtypes ) 767 784 … … 799 816 nvarssurf(jtype) = 1 800 817 nextrsurf(jtype) = 0 818 ltype_clim = .FALSE. 801 819 IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) nextrsurf(jtype) = 2 820 IF ( ln_output_clim .AND. & 821 & ( ( TRIM(cobstypessurf(jtype)) == 'sst' ) .OR. & 822 & ( TRIM(cobstypessurf(jtype)) == 'sss' ) ) ) & 823 & ltype_clim = .TRUE. 802 824 803 825 !Read in surface obs types … … 805 827 & clsurffiles(jtype,1:ifilessurf(jtype)), & 806 828 & nvarssurf(jtype), nextrsurf(jtype), nitend-nit000+2, & 807 & rn_dobsini, rn_dobsend, ln_ignmis, .FALSE., llnightav(jtype) ) 829 & rn_dobsini, rn_dobsend, ln_ignmis, .FALSE., & 830 & llnightav(jtype), ltype_clim ) 808 831 809 832 CALL obs_pre_surf( surfdata(jtype), surfdataqc(jtype), ln_nea, ln_bound_reject ) … … 926 949 REAL(wp) :: tiny ! small number 927 950 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: & 928 & zprofvar ! Model values for variables in a prof ob 951 & zprofvar, & ! Model values for variables in a prof ob 952 & zprofclim ! Climatology values for variables in a prof ob 929 953 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: & 930 954 & zprofmask ! Mask associated with zprofvar 931 955 REAL(wp), POINTER, DIMENSION(:,:) :: & 932 956 & zsurfvar, & ! Model values equivalent to surface ob. 957 & zsurfclim, & ! Climatology values for variables in a surface ob. 933 958 & zsurfmask ! Mask associated with surface variable 934 959 REAL(wp), POINTER, DIMENSION(:,:,:) :: & … … 940 965 & pco2_3d ! 3D pCO2 from FABM 941 966 #endif 942 967 943 968 IF(lwp) THEN 944 969 WRITE(numout,*) … … 963 988 CALL wrk_alloc( jpi, jpj, profdataqc(jtype)%nvar, zglam ) 964 989 CALL wrk_alloc( jpi, jpj, profdataqc(jtype)%nvar, zgphi ) 965 990 CALL wrk_alloc( jpi, jpj, jpk, profdataqc(jtype)%nvar, zprofclim ) 991 966 992 ! Defaults which might change 967 993 DO jvar = 1, profdataqc(jtype)%nvar … … 969 995 zglam(:,:,jvar) = glamt(:,:) 970 996 zgphi(:,:,jvar) = gphit(:,:) 997 zprofclim(:,:,:,jvar) = 0._wp 971 998 END DO 972 999 … … 976 1003 zprofvar(:,:,:,1) = tsn(:,:,:,jp_tem) 977 1004 zprofvar(:,:,:,2) = tsn(:,:,:,jp_sal) 978 1005 IF ( ln_output_clim ) THEN 1006 zprofclim(:,:,:,1) = tclim(:,:,:) 1007 zprofclim(:,:,:,2) = sclim(:,:,:) 1008 ENDIF 1009 979 1010 CASE('vel') 980 1011 zprofvar(:,:,:,1) = un(:,:,:) … … 1155 1186 & nit000, idaystp, jvar, & 1156 1187 & zprofvar(:,:,:,jvar), & 1188 & zprofclim(:,:,:,jvar), & 1157 1189 & fsdept(:,:,:), fsdepw(:,:,:), & 1158 1190 & zprofmask(:,:,:,jvar), & … … 1166 1198 CALL wrk_dealloc( jpi, jpj, profdataqc(jtype)%nvar, zglam ) 1167 1199 CALL wrk_dealloc( jpi, jpj, profdataqc(jtype)%nvar, zgphi ) 1200 CALL wrk_dealloc( jpi, jpj, jpk, profdataqc(jtype)%nvar, zprofclim ) 1168 1201 1169 1202 END DO … … 1175 1208 !Allocate local work arrays 1176 1209 CALL wrk_alloc( jpi, jpj, zsurfvar ) 1210 CALL wrk_alloc( jpi, jpj, zsurfclim ) 1177 1211 CALL wrk_alloc( jpi, jpj, zsurfmask ) 1178 1212 #if defined key_fabm … … 1184 1218 !Defaults which might be changed 1185 1219 zsurfmask(:,:) = tmask(:,:,1) 1220 zsurfclim(:,:) = 0._wp 1186 1221 llog10 = .FALSE. 1187 1222 … … 1189 1224 CASE('sst') 1190 1225 zsurfvar(:,:) = tsn(:,:,1,jp_tem) 1226 IF ( ln_output_clim ) zsurfclim(:,:) = tclim(:,:,1) 1191 1227 CASE('sla') 1192 1228 zsurfvar(:,:) = sshn(:,:) 1193 1229 CASE('sss') 1194 1230 zsurfvar(:,:) = tsn(:,:,1,jp_sal) 1231 IF ( ln_output_clim ) zsurfclim(:,:) = sclim(:,:,1) 1195 1232 CASE('sic') 1196 1233 IF ( kstp == 0 ) THEN … … 1485 1522 1486 1523 CALL obs_surf_opt( surfdataqc(jtype), kstp, jpi, jpj, & 1487 & nit000, idaystp, zsurfvar, zsurfmask, & 1524 & nit000, idaystp, zsurfvar, & 1525 & zsurfclim, zsurfmask, & 1488 1526 & n2dintsurf(jtype), llnightav(jtype), & 1489 & ravglamscl(jtype), ravgphiscl(jtype), 1527 & ravglamscl(jtype), ravgphiscl(jtype), & 1490 1528 & lfpindegs(jtype) ) 1491 1529 -
branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90
r9306 r11468 62 62 SUBROUTINE obs_prof_opt( prodatqc, kt, kpi, kpj, kpk, & 63 63 & kit000, kdaystp, kvar, & 64 & pvar, p gdept, pgdepw,&65 & p mask,&64 & pvar, pclim, & 65 & pgdept, pgdepw, pmask, & 66 66 & plam, pphi, & 67 67 & k1dint, k2dint, kdailyavtypes ) … … 137 137 REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: & 138 138 & pvar, & ! Model field for variable 139 & pclim, & ! Climatology field for variable 139 140 & pmask ! Land-sea mask for variable 140 141 REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: & … … 172 173 REAL(KIND=wp), DIMENSION(kpk) :: & 173 174 & zobsk, & 174 & zobs2k 175 & zobs2k, & 176 & zclm2k 175 177 REAL(KIND=wp), DIMENSION(2,2,1) :: & 176 178 & zweig1, & … … 178 180 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: & 179 181 & zmask, & 182 & zclim, & 180 183 & zint, & 181 184 & zinm, & … … 187 190 REAL(KIND=wp), DIMENSION(1) :: zmsk 188 191 REAL(KIND=wp), DIMENSION(:,:,:), ALLOCATABLE :: interp_corner 189 192 REAL(KIND=wp), DIMENSION(:,:,:), ALLOCATABLE :: interp_corner_clim 193 190 194 LOGICAL :: ld_dailyav 191 195 … … 262 266 & ) 263 267 268 IF ( prodatqc%lclim ) ALLOCATE( zclim(2,2,kpk,ipro) ) 269 264 270 DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro 265 271 iobs = jobs - prodatqc%nprofup … … 286 292 CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, pgdepw, zgdepw ) 287 293 294 IF ( prodatqc%lclim ) THEN 295 CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, pclim, zclim ) 296 ENDIF 297 288 298 ! At the end of the day also get interpolated means 289 299 IF ( ld_dailyav .AND. idayend == 0 ) THEN … … 349 359 inum_obs = iend - ista + 1 350 360 ALLOCATE(interp_corner(2,2,inum_obs),iv_indic(inum_obs)) 351 361 IF ( prodatqc%lclim ) ALLOCATE( interp_corner_clim(2,2,inum_obs) ) 362 352 363 DO iin=1,2 353 364 DO ijn=1,2 … … 358 369 & zobs2k, zgdept(iin,ijn,:,iobs), & 359 370 & zmask(iin,ijn,:,iobs)) 371 372 IF ( prodatqc%lclim ) THEN 373 CALL obs_int_z1d_spl( kpk, & 374 & zclim(iin,ijn,:,iobs), & 375 & zclm2k, zgdept(iin,ijn,:,iobs), & 376 & zmask(iin,ijn,:,iobs)) 377 ENDIF 378 360 379 ENDIF 361 380 … … 371 390 & zgdept(iin,ijn,:,iobs), & 372 391 & zmask(iin,ijn,:,iobs)) 373 392 393 IF ( prodatqc%lclim ) THEN 394 CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs, & 395 & prodatqc%var(kvar)%vdep(ista:iend), & 396 & zclim(iin,ijn,:,iobs), & 397 & zclm2k, interp_corner_clim(iin,ijn,:), & 398 & zgdept(iin,ijn,:,iobs), & 399 & zmask(iin,ijn,:,iobs)) 400 ENDIF 401 374 402 ENDDO 375 403 ENDDO … … 386 414 inum_obs = iend - ista + 1 387 415 ALLOCATE(interp_corner(2,2,inum_obs), iv_indic(inum_obs)) 416 IF ( prodatqc%lclim ) ALLOCATE( interp_corner_clim(2,2,inum_obs) ) 388 417 DO iin=1,2 389 418 DO ijn=1,2 … … 394 423 & zobs2k, zgdept(iin,ijn,:,iobs), & 395 424 & zmask(iin,ijn,:,iobs)) 425 426 IF ( prodatqc%lclim ) THEN 427 CALL obs_int_z1d_spl( kpk, & 428 & zclim(iin,ijn,:,iobs),& 429 & zclm2k, zgdept(iin,ijn,:,iobs), & 430 & zmask(iin,ijn,:,iobs)) 431 ENDIF 396 432 397 433 ENDIF … … 408 444 & zgdept(iin,ijn,:,iobs), & 409 445 & zmask(iin,ijn,:,iobs) ) 446 447 IF ( prodatqc%lclim ) THEN 448 CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs, & 449 & prodatqc%var(kvar)%vdep(ista:iend), & 450 & zclim(iin,ijn,:,iobs), & 451 & zclm2k,interp_corner_clim(iin,ijn,:), & 452 & zgdept(iin,ijn,:,iobs), & 453 & zmask(iin,ijn,:,iobs) ) 454 ENDIF 410 455 411 456 ENDDO … … 451 496 & prodatqc%var(kvar)%vmod(iend:iend) ) 452 497 498 IF ( prodatqc%lclim ) THEN 499 CALL obs_int_h2d( 1, 1, zweig, interp_corner_clim(:,:,ikn), & 500 & prodatqc%var(kvar)%vclm(iend:iend) ) 501 ENDIF 502 453 503 ! Set QC flag for any observations found below the bottom 454 504 ! needed as the check here is more strict than that in obs_prep … … 458 508 459 509 DEALLOCATE(interp_corner,iv_indic) 460 510 IF ( prodatqc%lclim ) DEALLOCATE( interp_corner_clim ) 511 461 512 ENDIF 462 513 … … 475 526 & ) 476 527 528 IF ( prodatqc%lclim ) DEALLOCATE( zclim ) 529 477 530 ! At the end of the day also get interpolated means 478 531 IF ( ld_dailyav .AND. idayend == 0 ) THEN … … 487 540 488 541 SUBROUTINE obs_surf_opt( surfdataqc, kt, kpi, kpj, & 489 & kit000, kdaystp, psurf, p surfmask, &542 & kit000, kdaystp, psurf, pclim, psurfmask, & 490 543 & k2dint, ldnightav, plamscl, pphiscl, & 491 544 & lindegrees ) … … 541 594 REAL(wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 542 595 & psurf, & ! Model surface field 596 & pclim, & ! Climatological surface field 543 597 & psurfmask ! Land-sea mask 544 598 LOGICAL, INTENT(IN) :: ldnightav ! Logical for averaging night-time data … … 569 623 REAL(wp) :: zlam 570 624 REAL(wp) :: zphi 571 REAL(wp), DIMENSION(1) :: zext, zobsmask 625 REAL(wp), DIMENSION(1) :: zext, zobsmask, zclm 572 626 REAL(wp) :: zdaystp 573 627 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & … … 577 631 & zsurfm, & 578 632 & zsurftmp, & 633 & zclim, & 579 634 & zglam, & 580 635 & zgphi, & … … 586 641 & zouttmp, & 587 642 & zmeanday ! to compute model sst in region of 24h daylight (pole) 588 643 589 644 !------------------------------------------------------------------------ 590 645 ! Local initialization … … 679 734 & ) 680 735 736 IF ( surfdataqc%lclim ) ALLOCATE( zclim(imaxifp,imaxjfp,isurf) ) 737 681 738 DO jobs = surfdataqc%nsurfup + 1, surfdataqc%nsurfup + isurf 682 739 iobs = jobs - surfdataqc%nsurfup … … 715 772 CALL obs_int_comm_2d( imaxifp, imaxjfp, isurf, kpi, kpj, & 716 773 & igrdi, igrdj, psurf, zsurf ) 717 CALL obs_int_comm_2d( imaxifp+1, imaxjfp+1, isurf, kpi, kpj, & 718 & igrdip1, igrdjp1, glamf, zglamf ) 719 CALL obs_int_comm_2d( imaxifp+1, imaxjfp+1, isurf, kpi, kpj, & 720 & igrdip1, igrdjp1, gphif, zgphif ) 774 775 IF ( k2dint > 4 ) THEN 776 CALL obs_int_comm_2d( imaxifp+1, imaxjfp+1, isurf, kpi, kpj, & 777 & igrdip1, igrdjp1, glamf, zglamf ) 778 CALL obs_int_comm_2d( imaxifp+1, imaxjfp+1, isurf, kpi, kpj, & 779 & igrdip1, igrdjp1, gphif, zgphif ) 780 ENDIF 781 782 IF ( surfdataqc%lclim ) THEN 783 CALL obs_int_comm_2d( imaxifp, imaxjfp, isurf, kpi, kpj, & 784 & igrdi, igrdj, pclim, zclim ) 785 ENDIF 721 786 722 787 ! At the end of the day get interpolated means … … 775 840 CALL obs_int_h2d( 1, 1, zweig, zsurftmp(:,:,iobs), zext ) 776 841 842 IF ( surfdataqc%lclim ) THEN 843 CALL obs_int_h2d( 1, 1, zweig, zclim(:,:,iobs), zclm ) 844 ENDIF 845 846 777 847 ELSE 778 848 … … 788 858 & zweig, zsurftmp(:,:,iobs), zext ) 789 859 860 IF ( surfdataqc%lclim ) THEN 861 CALL obs_avg_h2d( 1, 1, imaxifp, imaxjfp, & 862 & zweig, zclim(:,:,iobs), zclm ) 863 ENDIF 864 790 865 ENDIF 791 866 … … 797 872 surfdataqc%rmod(jobs,1) = zext(1) 798 873 ENDIF 874 875 IF ( surfdataqc%lclim ) surfdataqc%rclm(jobs,1) = zclm(1) 799 876 800 877 IF ( zext(1) == obfillflt ) THEN … … 821 898 & ) 822 899 900 IF ( surfdataqc%lclim ) DEALLOCATE( zclim ) 901 823 902 ! At the end of the day also deallocate night-time mean array 824 903 IF ( idayend == 0 .AND. ldnightav ) THEN -
branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/obs_profiles_def.F90
r7992 r11468 72 72 & vdep, & !: Depth coordinate of profile data 73 73 & vobs, & !: Profile data 74 & vmod !: Model counterpart of the profile data vector 75 74 & vmod, & !: Model counterpart of the profile data vector 75 & vclm !: Climatological counterpart of the profile data vector 76 76 77 REAL(KIND=wp), POINTER, DIMENSION(:,:) :: & 77 78 & vext !: Extra variables … … 102 103 INTEGER :: nprofup !: Observation counter used in obs_oper 103 104 105 LOGICAL :: lclim !: Climatology will be calculated for this structure 106 104 107 ! Bookkeeping arrays with sizes equal to number of variables 105 108 … … 198 201 199 202 SUBROUTINE obs_prof_alloc( prof, kvar, kext, kprof, & 200 & ko3dt, kstp, kpi, kpj, kpk )203 & ko3dt, kstp, kpi, kpj, kpk, ldclim ) 201 204 !!---------------------------------------------------------------------- 202 205 !! *** ROUTINE obs_prof_alloc *** … … 221 224 INTEGER, INTENT(IN) :: kpj 222 225 INTEGER, INTENT(IN) :: kpk 226 LOGICAL, INTENT(IN) :: ldclim 223 227 224 228 !!* Local variables … … 236 240 prof%npj = kpj 237 241 prof%npk = kpk 242 243 prof%lclim = ldclim 238 244 239 245 ! Allocate arrays of size number of variables … … 503 509 & ) 504 510 ENDIF 511 IF (prof%lclim) THEN 512 ALLOCATE( & 513 & prof%var(kvar)%vclm(kobs) & 514 & ) 515 ENDIF 505 516 506 517 END SUBROUTINE obs_prof_alloc_var … … 537 548 DEALLOCATE( & 538 549 & prof%var(kvar)%vext & 550 & ) 551 ENDIF 552 IF (prof%lclim) THEN 553 DEALLOCATE( & 554 & prof%var(kvar)%vclm & 539 555 & ) 540 556 ENDIF … … 630 646 & inprof, invpro, & 631 647 & prof%nstp, prof%npi, & 632 & prof%npj, prof%npk ) 648 & prof%npj, prof%npk, & 649 & prof%lclim ) 633 650 ENDIF 634 651 … … 745 762 & prof%var(jvar)%vext(jj,jext) 746 763 END DO 747 764 IF (newprof%lclim) THEN 765 newprof%var(jvar)%vclm(invpro(jvar)) = & 766 & prof%var(jvar)%vclm(jj) 767 ENDIF 768 748 769 ! nvind is the index of the original variable data 749 770 … … 870 891 & prof%var(jvar)%vext(jj,jext) 871 892 END DO 872 893 IF (prof%lclim) THEN 894 oldprof%var(jvar)%vclm(jl) = prof%var(jvar)%vclm(jj) 895 ENDIF 873 896 END DO 874 897 -
branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90
r9306 r11468 46 46 & kvars, kextr, kstp, ddobsini, ddobsend, & 47 47 & ldvar, ldignmis, ldsatt, & 48 & ldmod, kdailyavtypes )48 & ldmod, ldclim, kdailyavtypes ) 49 49 !!--------------------------------------------------------------------- 50 50 !! … … 78 78 LOGICAL, INTENT(IN) :: ldsatt ! Compute salinity at all temperature points 79 79 LOGICAL, INTENT(IN) :: ldmod ! Initialize model from input data 80 LOGICAL, INTENT(IN) :: ldclim ! Set flag to show climatology will be output 80 81 REAL(dp), INTENT(IN) :: ddobsini ! Obs. ini time in YYYYMMDD.HHMMSS 81 82 REAL(dp), INTENT(IN) :: ddobsend ! Obs. end time in YYYYMMDD.HHMMSS … … 500 501 ENDIF 501 502 CALL obs_prof_alloc( profdata, kvars, kextr, iprof, iv3dt, & 502 & kstp, jpi, jpj, jpk )503 & kstp, jpi, jpj, jpk, ldclim ) 503 504 504 505 ! * Read obs/positions, QC, all variable and assign to profdata … … 697 698 & inpfiles(jj)%padd(ij,ji,1,jvar) 698 699 ENDIF 700 IF ( profdata%lclim ) THEN 701 profdata%var(jvar)%vclm(ivart(jvar)) = fbrmdi 702 ENDIF 699 703 ! Count number of profile var1 data as function of type 700 704 itypvar( profdata%ntyp(iprof) + 1, jvar ) = & -
branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_surf.F90
r9308 r11468 40 40 SUBROUTINE obs_rea_surf( surfdata, knumfiles, cdfilenames, & 41 41 & kvars, kextr, kstp, ddobsini, ddobsend, & 42 & ldignmis, ldmod, ldnightav )42 & ldignmis, ldmod, ldnightav, ldclim ) 43 43 !!--------------------------------------------------------------------- 44 44 !! … … 71 71 LOGICAL, INTENT(IN) :: ldmod ! Initialize model from input data 72 72 LOGICAL, INTENT(IN) :: ldnightav ! Observations represent a night-time average 73 LOGICAL, INTENT(IN) :: ldclim ! Will include climatology at obs points. 73 74 REAL(dp), INTENT(IN) :: ddobsini ! Obs. ini time in YYYYMMDD.HHMMSS 74 75 REAL(dp), INTENT(IN) :: ddobsend ! Obs. end time in YYYYMMDD.HHMMSS … … 359 360 & iindx ) 360 361 361 CALL obs_surf_alloc( surfdata, iobs, kvars, iextr, kstp, jpi, jpj )362 CALL obs_surf_alloc( surfdata, iobs, kvars, iextr, kstp, jpi, jpj, ldclim ) 362 363 363 364 ! Read obs/positions, QC, all variable and assign to surfdata … … 462 463 IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) surfdata%rext(iobs,:) = fbrmdi 463 464 ENDIF 464 465 466 ! Initialise climatology if set 467 IF ( surfdata%lclim ) surfdata%rclm(iobs,1) = fbrmdi 468 465 469 ! STD (obs error standard deviation) read from file and passed through obs operator 466 470 IF ( iadd_std(jj) /= -1 ) THEN -
branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/obs_surf_def.F90
r9308 r11468 52 52 INTEGER :: nrec !: Number of surface observation records in window 53 53 54 LOGICAL :: lclim !: Climatology will be calculated for this structure 55 54 56 ! Arrays with size equal to the number of surface observations 55 57 … … 84 86 REAL(KIND=wp), POINTER, DIMENSION(:,:) :: & 85 87 & robs, & !: Surface observation 86 & rmod !: Model counterpart of the surface observation vector 87 88 & rmod, & !: Model counterpart of the surface observation vector 89 & rclm !: Climatological counterpart of the surface observation vector 90 88 91 REAL(KIND=wp), POINTER, DIMENSION(:,:) :: & 89 92 & rext !: Extra fields interpolated to observation points … … 124 127 CONTAINS 125 128 126 SUBROUTINE obs_surf_alloc( surf, ksurf, kvar, kextra, kstp, kpi, kpj )129 SUBROUTINE obs_surf_alloc( surf, ksurf, kvar, kextra, kstp, kpi, kpj, ldclim ) 127 130 !!---------------------------------------------------------------------- 128 131 !! *** ROUTINE obs_surf_alloc *** … … 143 146 INTEGER, INTENT(IN) :: kpi ! Number of 3D grid points 144 147 INTEGER, INTENT(IN) :: kpj 148 LOGICAL, INTENT(IN) :: ldclim 145 149 146 150 !!* Local variables … … 157 161 surf%npi = kpi 158 162 surf%npj = kpj 163 surf%lclim = ldclim 159 164 160 165 ! Allocate arrays of size number of variables … … 197 202 ALLOCATE( & 198 203 & surf%robs(ksurf,kvar), & 199 & surf%rmod(ksurf,kvar) 204 & surf%rmod(ksurf,kvar) & 200 205 & ) 201 206 207 IF (surf%lclim) ALLOCATE( surf%rclm(ksurf,kvar) ) 208 202 209 ! Allocate arrays of number of extra fields at observation points 203 210 … … 293 300 & ) 294 301 302 IF (surf%lclim) DEALLOCATE( surf%rclm ) 295 303 ! Deallocate arrays of number of extra fields at observation points 296 304 … … 371 379 IF ( lallocate ) THEN 372 380 CALL obs_surf_alloc( newsurf, insurf, surf%nvar, & 373 & surf%nextra, surf%nstp, surf%npi, surf%npj )381 & surf%nextra, surf%nstp, surf%npi, surf%npj, surf%lclim ) 374 382 ENDIF 375 383 … … 418 426 newsurf%robs(insurf,jk) = surf%robs(ji,jk) 419 427 newsurf%rmod(insurf,jk) = surf%rmod(ji,jk) 428 IF (newsurf%lclim) newsurf%rclm(insurf,jk) = surf%rclm(ji,jk) 420 429 421 430 END DO … … 514 523 oldsurf%robs(jj,jk) = surf%robs(ji,jk) 515 524 oldsurf%rmod(jj,jk) = surf%rmod(ji,jk) 525 IF (surf%lclim) oldsurf%rclm(jj,jk) = surf%rclm(ji,jk) 516 526 517 527 END DO -
branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90
r9308 r11468 95 95 INTEGER :: je 96 96 INTEGER :: iadd 97 INTEGER :: iadd_clm ! 1 if climatology present 97 98 INTEGER :: iext 98 99 REAL(wp) :: zpres 99 100 101 102 iadd_clm = 0 103 IF ( profdata%lclim ) iadd_clm = 1 104 100 105 IF ( PRESENT( padd ) ) THEN 101 106 iadd = padd%inum … … 123 128 clfiletype='profb' 124 129 CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, & 125 & 1 + iadd , 1 + iext, .TRUE. )130 & 1 + iadd_clm + iadd, 1 + iext, .TRUE. ) 126 131 fbdata%cname(1) = profdata%cvars(1) 127 132 fbdata%cname(2) = profdata%cvars(2) … … 137 142 fbdata%caddunit(1,1) = 'Degrees centigrade' 138 143 fbdata%caddunit(1,2) = 'PSU' 144 IF ( profdata%lclim ) THEN 145 fbdata%caddlong(2,1) = 'Climatology interpolated potential temperature' 146 fbdata%caddlong(2,2) = 'Climatology interpolated practical salinity' 147 fbdata%caddunit(2,1) = 'Degrees centigrade' 148 fbdata%caddunit(2,2) = 'PSU' 149 ENDIF 139 150 fbdata%cgrid(:) = 'T' 140 151 DO je = 1, iext … … 144 155 END DO 145 156 DO ja = 1, iadd 146 fbdata%caddname(1+ ja) = padd%cdname(ja)157 fbdata%caddname(1+iadd_clm+ja) = padd%cdname(ja) 147 158 DO jvar = 1, 2 148 fbdata%caddlong(1+ ja,jvar) = padd%cdlong(ja,jvar)149 fbdata%caddunit(1+ ja,jvar) = padd%cdunit(ja,jvar)159 fbdata%caddlong(1+iadd_clm+ja,jvar) = padd%cdlong(ja,jvar) 160 fbdata%caddunit(1+iadd_clm+ja,jvar) = padd%cdunit(ja,jvar) 150 161 END DO 151 162 END DO … … 154 165 155 166 clfiletype='velfb' 156 CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, 1, 0, .TRUE. ) 167 CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, & 168 & 1 + iadd_clm + iadd, 0, .TRUE. ) 157 169 fbdata%cname(1) = profdata%cvars(1) 158 170 fbdata%cname(2) = profdata%cvars(2) … … 170 182 fbdata%caddunit(1,1) = 'm/s' 171 183 fbdata%caddunit(1,2) = 'm/s' 184 IF ( profdata%lclim ) THEN 185 fbdata%caddlong(2,1) = 'Climatology interpolated zonal velocity' 186 fbdata%caddlong(2,2) = 'Climatology interpolated meridional velocity' 187 fbdata%caddunit(2,1) = 'm/s' 188 fbdata%caddunit(2,2) = 'm/s' 189 ENDIF 172 190 fbdata%cgrid(1) = 'U' 173 191 fbdata%cgrid(2) = 'V' 174 192 DO ja = 1, iadd 175 fbdata%caddname(1+ ja) = padd%cdname(ja)176 fbdata%caddlong(1+ ja,1) = padd%cdlong(ja,1)177 fbdata%caddunit(1+ ja,1) = padd%cdunit(ja,1)193 fbdata%caddname(1+iadd_clm+ja) = padd%cdname(ja) 194 fbdata%caddlong(1+iadd_clm+ja,1) = padd%cdlong(ja,1) 195 fbdata%caddunit(1+iadd_clm+ja,1) = padd%cdunit(ja,1) 178 196 END DO 179 197 … … 246 264 & ( TRIM(profdata%cvars(1)) /= 'UVEL' ) ) THEN 247 265 CALL alloc_obfbdata( fbdata, 1, profdata%nprof, ilevel, & 248 & 1 + iadd , iext, .TRUE. )266 & 1 + iadd_clm + iadd, iext, .TRUE. ) 249 267 fbdata%cname(1) = profdata%cvars(1) 250 268 fbdata%coblong(1) = cllongname … … 252 270 fbdata%caddlong(1,1) = 'Model interpolated ' // TRIM(cllongname) 253 271 fbdata%caddunit(1,1) = clunits 272 IF ( profdata%lclim ) THEN 273 fbdata%caddlong(2,1) = 'Climatological interpolated ' // TRIM(cllongname) 274 fbdata%caddunit(2,1) = clunits 275 ENDIF 254 276 fbdata%cgrid(:) = clgrid 255 277 DO je = 1, iext … … 259 281 END DO 260 282 DO ja = 1, iadd 261 fbdata%caddname(1+ ja) = padd%cdname(ja)262 fbdata%caddlong(1+ ja,1) = padd%cdlong(ja,1)263 fbdata%caddunit(1+ ja,1) = padd%cdunit(ja,1)283 fbdata%caddname(1+iadd_clm+ja) = padd%cdname(ja) 284 fbdata%caddlong(1+iadd_clm+ja,1) = padd%cdlong(ja,1) 285 fbdata%caddunit(1+iadd_clm+ja,1) = padd%cdunit(ja,1) 264 286 END DO 265 287 ENDIF 266 288 267 289 fbdata%caddname(1) = 'Hx' 268 290 IF ( profdata%lclim ) fbdata%caddname(1+iadd_clm) = 'CLM' 291 269 292 WRITE(clfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(clfiletype), nproc 270 293 … … 319 342 DO jk = profdata%npvsta(jo,jvar), profdata%npvend(jo,jvar) 320 343 ik = profdata%var(jvar)%nvlidx(jk) 321 fbdata%padd(ik,jo,1,jvar) = profdata%var(jvar)%vmod(jk)322 344 fbdata%pob(ik,jo,jvar) = profdata%var(jvar)%vobs(jk) 323 345 fbdata%pdep(ik,jo) = profdata%var(jvar)%vdep(jk) … … 333 355 ENDIF 334 356 fbdata%iobsk(ik,jo,jvar) = profdata%var(jvar)%mvk(jk) 357 358 fbdata%padd(ik,jo,1,jvar) = profdata%var(jvar)%vmod(jk) 359 IF ( profdata%lclim ) THEN 360 fbdata%padd(ik,jo,1+iadd_clm,jvar) = profdata%var(jvar)%vclm(jk) 361 ENDIF 335 362 DO ja = 1, iadd 336 fbdata%padd(ik,jo,1+ ja,jvar) = &363 fbdata%padd(ik,jo,1+iadd_clm+ja,jvar) = & 337 364 & profdata%var(jvar)%vext(jk,padd%ipoint(ja)) 338 365 END DO … … 420 447 INTEGER :: indx_std 421 448 INTEGER :: iadd_std 422 449 INTEGER :: iadd_clm 450 INTEGER :: iadd_mdt 451 452 IF ( PRESENT( pext ) ) THEN 453 iext = pext%inum 454 ELSE 455 iext = 0 456 ENDIF 457 458 459 ! Set up number of additional variables to be ouput: 460 ! Hx, CLM, STD, MDT... 461 423 462 IF ( PRESENT( padd ) ) THEN 424 463 iadd = padd%inum … … 426 465 iadd = 0 427 466 ENDIF 428 429 IF ( PRESENT( pext ) ) THEN 430 iext = pext%inum 431 ELSE 432 iext = 0 433 ENDIF 434 467 435 468 iadd_std = 0 436 469 indx_std = -1 … … 444 477 ENDIF 445 478 479 iadd_clm = 0 480 IF ( surfdata%lclim ) iadd_clm = 1 481 482 iadd_mdt = 0 483 IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) iadd_mdt = 1 484 446 485 CALL init_obfbdata( fbdata ) 447 486 448 487 SELECT CASE ( TRIM(surfdata%cvars(1)) ) 449 488 CASE('SLA') 450 489 451 490 ! SLA needs special treatment because of MDT, so is all done here 452 491 ! Other variables are done more generically 492 ! No climatology for SLA, MDT is our best estimate of that and is already output. 453 493 454 494 CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 455 & 2 + iadd + iadd_std, 1 + iext, .TRUE. ) 495 & 1 + iadd_mdt + iadd_std + iadd, & 496 & 1 + iext, .TRUE. ) 456 497 457 498 clfiletype = 'slafb' … … 474 515 fbdata%cgrid(1) = 'T' 475 516 DO ja = 1, iadd 476 fbdata%caddname( 2+iadd_std+ja) = padd%cdname(ja)477 fbdata%caddlong( 2+iadd_std+ja,1) = padd%cdlong(ja,1)478 fbdata%caddunit( 2+iadd_std+ja,1) = padd%cdunit(ja,1)517 fbdata%caddname(1+iadd_mdt+iadd_std+ja) = padd%cdname(ja) 518 fbdata%caddlong(1+iadd_mdt+iadd_std+ja,1) = padd%cdlong(ja,1) 519 fbdata%caddunit(1+iadd_mdt+iadd_std+ja,1) = padd%cdunit(ja,1) 479 520 END DO 480 521 … … 485 526 clunits = 'Degree centigrade' 486 527 clgrid = 'T' 487 528 488 529 CASE('ICECONC') 489 530 … … 499 540 clunits = 'psu' 500 541 clgrid = 'T' 501 542 502 543 CASE('SLCHLTOT','LOGCHL','LogChl','logchl') 503 544 … … 610 651 611 652 CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 612 & 1 + iadd + iadd_std, iext, .TRUE. )653 & 1 + iadd_std + iadd_clm + iadd, iext, .TRUE. ) 613 654 614 655 fbdata%cname(1) = surfdata%cvars(1) … … 628 669 fbdata%cgrid(1) = clgrid 629 670 DO ja = 1, iadd 630 fbdata%caddname(1+iadd_ std+ja) = padd%cdname(ja)631 fbdata%caddlong(1+iadd_ std+ja,1) = padd%cdlong(ja,1)632 fbdata%caddunit(1+iadd_ std+ja,1) = padd%cdunit(ja,1)671 fbdata%caddname(1+iadd_mdt+iadd_std+iadd_clm+ja) = padd%cdname(ja) 672 fbdata%caddlong(1+iadd_mdt+iadd_std+iadd_clm+ja,1) = padd%cdlong(ja,1) 673 fbdata%caddunit(1+iadd_mdt+iadd_std+iadd_clm+ja,1) = padd%cdunit(ja,1) 633 674 END DO 634 675 … … 637 678 fbdata%caddname(1) = 'Hx' 638 679 IF ( indx_std /= -1 ) THEN 639 IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) iadd_std = iadd_std + 1 640 fbdata%caddname(1+iadd_std) = surfdata%cext(indx_std) 641 fbdata%caddlong(1+iadd_std,1) = 'Obs error standard deviation' 642 fbdata%caddunit(1+iadd_std,1) = fbdata%cobunit(1) 643 ENDIF 680 fbdata%caddname(1+iadd_mdt+iadd_std) = surfdata%cext(indx_std) 681 fbdata%caddlong(1+iadd_mdt+iadd_std,1) = 'Obs error standard deviation' 682 fbdata%caddunit(1+iadd_mdt+iadd_std,1) = fbdata%cobunit(1) 683 ENDIF 684 685 IF ( surfdata%lclim ) THEN 686 fbdata%caddname(1+iadd_mdt+iadd_std+iadd_clm) = 'CLM' 687 fbdata%caddlong(1+iadd_mdt+iadd_std+iadd_clm,1) = 'Climatology' 688 fbdata%caddunit(1+iadd_mdt+iadd_std+iadd_clm,1) = fbdata%cobunit(1) 689 ENDIF 690 644 691 645 692 WRITE(clfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(clfiletype), nproc … … 689 736 & fbdata%ptim(jo), & 690 737 & krefdate = 19500101 ) 691 fbdata%padd(1,jo,1,1) = surfdata%rmod(jo,1) 692 IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) fbdata%padd(1,jo,2,1) = surfdata%rext(jo,1) 738 693 739 fbdata%pob(1,jo,1) = surfdata%robs(jo,1) 694 740 fbdata%pdep(1,jo) = 0.0 … … 706 752 ENDIF 707 753 fbdata%iobsk(1,jo,1) = 0 708 IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) fbdata%pext(1,jo,1) = surfdata%rext(jo,2) 754 755 ! Additional variables. 756 ! Hx is always the first additional variable 757 fbdata%padd(1,jo,1,1) = surfdata%rmod(jo,1) 758 ! MDT is output as an additional variable if SLA obs type 759 IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) THEN 760 fbdata%padd(1,jo,1+iadd_mdt,1) = surfdata%rext(jo,1) 761 ENDIF 762 ! STD is output as an additional variable if available 709 763 IF ( indx_std /= -1 ) THEN 710 fbdata%padd(1,jo,1+iadd_ std,1) = surfdata%rext(jo,indx_std)764 fbdata%padd(1,jo,1+iadd_mdt+iadd_std,1) = surfdata%rext(jo,indx_std) 711 765 ENDIF 766 ! CLM is output as an additional variable if available 767 IF ( surfdata%lclim ) THEN 768 fbdata%padd(1,jo,1+iadd_mdt+iadd_std+iadd_clm,1) = surfdata%rclm(jo,1) 769 ENDIF 770 ! Then other additional variables are output 771 DO ja = 1, iadd 772 fbdata%padd(1,jo,1+iadd_mdt+iadd_std+iadd_clm+ja,1) = & 773 & surfdata%rext(jo,padd%ipoint(ja)) 774 END DO 712 775 713 DO ja = 1, iadd 714 fbdata%padd(1,jo,2+iadd_std+ja,1) = & 715 & surfdata%rext(jo,padd%ipoint(ja)) 716 END DO 776 ! Extra variables 777 IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) fbdata%pext(1,jo,1) = surfdata%rext(jo,2) 717 778 DO je = 1, iext 718 779 fbdata%pext(1,jo,1+je) = & -
branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90
r7960 r11468 55 55 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ttrdmp !: damping temperature trend (Celcius/s) 56 56 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: resto !: restoring coeff. on T and S (s-1) 57 57 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tclim !: temperature climatology on each time step(Celcius) 58 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sclim !: salinity climatology on each time step (psu) 59 58 60 !! * Substitutions 59 61 # include "domzgr_substitute.h90" … … 70 72 !! *** FUNCTION tra_dmp_alloc *** 71 73 !!---------------------------------------------------------------------- 72 ALLOCATE( strdmp(jpi,jpj,jpk) , ttrdmp(jpi,jpj,jpk), resto(jpi,jpj,jpk), STAT= tra_dmp_alloc ) 74 ALLOCATE( strdmp(jpi,jpj,jpk) , ttrdmp(jpi,jpj,jpk), resto(jpi,jpj,jpk), & 75 & tclim(jpi,jpj,jpk) , sclim(jpi,jpj,jpk), STAT= tra_dmp_alloc ) 73 76 ! 74 77 IF( lk_mpp ) CALL mpp_sum ( tra_dmp_alloc ) … … 110 113 ! !== input T-S data at kt ==! 111 114 CALL dta_tsd( kt, zts_dta ) ! read and interpolates T-S data at kt 115 116 tclim(:,:,:) = zts_dta(:,:,:,jp_tem) 117 sclim(:,:,:) = zts_dta(:,:,:,jp_sal) 112 118 ! 113 119 SELECT CASE ( nn_zdmp ) !== type of damping ==!
Note: See TracChangeset
for help on using the changeset viewer.