- Timestamp:
- 2019-08-19T17:36:23+02:00 (5 years ago)
- Location:
- branches/UKMO/dev_r5518_obs_oper_update_addclim/NEMOGCM
- Files:
-
- 9 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_obs_oper_update_addclim/NEMOGCM/CONFIG/SHARED/namelist_ref
r9306 r11455 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_addclim/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
r11449 r11455 50 50 LOGICAL :: ln_diaobs !: Logical switch for the obs operator 51 51 LOGICAL :: ln_sstnight !: Logical switch for night mean SST obs 52 LOGICAL :: ln_output_clim !: Logical switch for interpolating and outputting T/S climatology53 52 LOGICAL :: ln_default_fp_indegs !: T=> Default obs footprint size specified in degrees, F=> in metres 54 53 LOGICAL :: ln_sla_fp_indegs !: T=> SLA obs footprint size specified in degrees, F=> in metres … … 56 55 LOGICAL :: ln_sss_fp_indegs !: T=> SSS obs footprint size specified in degrees, F=> in metres 57 56 LOGICAL :: ln_sic_fp_indegs !: T=> sea-ice obs footprint size specified in degrees, F=> in metres 57 LOGICAL :: ln_output_clim !: Logical switch for interpolating and writing T/S climatology 58 58 59 59 REAL(wp) :: rn_default_avglamscl !: Default E/W diameter of observation footprint … … 235 235 LOGICAL :: ltype_fp_indegs ! Local version of ln_*_fp_indegs 236 236 LOGICAL :: ltype_night ! Local version of ln_sstnight (false for other variables) 237 LOGICAL :: ltype_clim ! Local version of ln_output_clim 237 238 238 239 REAL(wp), POINTER, DIMENSION(:,:,:) :: & … … 728 729 729 730 DO jtype = 1, nproftypes 730 731 732 ltype_clim = .FALSE. 733 731 734 IF ( TRIM(cobstypesprof(jtype)) == 'prof' ) THEN 732 735 nvarsprof(jtype) = 2 733 736 nextrprof(jtype) = 1 737 IF ( ln_output_clim ) ltype_clim = .TRUE. 734 738 ALLOCATE(llvar(nvarsprof(jtype))) 735 739 CALL wrk_alloc( jpi, jpj, nvarsprof(jtype), zglam ) … … 777 781 & nvarsprof(jtype), nextrprof(jtype), nitend-nit000+2, & 778 782 & rn_dobsini, rn_dobsend, llvar, & 779 & ln_ignmis, ln_s_at_t, .FALSE., &783 & ln_ignmis, ln_s_at_t, .FALSE., ltype_clim, & 780 784 & kdailyavtypes = nn_profdavtypes ) 781 785 … … 813 817 nvarssurf(jtype) = 1 814 818 nextrsurf(jtype) = 0 819 ltype_clim = .FALSE. 815 820 IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) nextrsurf(jtype) = 2 821 IF ( ln_output_clim .AND. & 822 & ( ( TRIM(cobstypessurf(jtype)) == 'sst' ) .OR. & 823 & ( TRIM(cobstypessurf(jtype)) == 'sss' ) ) ) & 824 & ltype_clim = .TRUE. 816 825 817 826 !Read in surface obs types … … 819 828 & clsurffiles(jtype,1:ifilessurf(jtype)), & 820 829 & nvarssurf(jtype), nextrsurf(jtype), nitend-nit000+2, & 821 & rn_dobsini, rn_dobsend, ln_ignmis, .FALSE., llnightav(jtype) ) 830 & rn_dobsini, rn_dobsend, ln_ignmis, .FALSE., & 831 & llnightav(jtype), ltype_clim ) 822 832 823 833 CALL obs_pre_surf( surfdata(jtype), surfdataqc(jtype), ln_nea, ln_bound_reject ) … … 928 938 & jp_spm 929 939 #endif 940 USE tradmp, ONLY: & 941 & tclim, & 942 & sclim 930 943 931 944 IMPLICIT NONE … … 956 969 & pco2_3d ! 3D pCO2 from FABM 957 970 #endif 958 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zts_dta959 971 960 972 IF(lwp) THEN … … 966 978 967 979 idaystp = NINT( rday / rdt ) 968 969 ! Get the climatological T & S fields on this time step970 IF ( ln_output_clim ) CALL dta_tsd( kstp, zts_dta )971 980 972 981 !----------------------------------------------------------------------- … … 998 1007 zprofvar(:,:,:,1) = tsn(:,:,:,jp_tem) 999 1008 zprofvar(:,:,:,2) = tsn(:,:,:,jp_sal) 1000 IF ( ln_output_clim ) THEN 1001 zprofclim(:,:,:,1) = zts_dta(:,:,:,jp_tem)1002 zprofclim(:,:,:,2) = zts_dta(:,:,:,jp_sal)1009 IF ( ln_output_clim ) THEN 1010 zprofclim(:,:,:,1) = tclim(:,:,:) 1011 zprofclim(:,:,:,2) = sclim(:,:,:) 1003 1012 ENDIF 1004 1013 … … 1219 1228 CASE('sst') 1220 1229 zsurfvar(:,:) = tsn(:,:,1,jp_tem) 1221 IF ( ln_output_clim ) zsurfclim(:,:) = zts_dta(:,:,1,jp_tem)1230 IF ( ln_output_clim ) zsurfclim(:,:) = tclim(:,:,1) 1222 1231 CASE('sla') 1223 1232 zsurfvar(:,:) = sshn(:,:) 1224 1233 CASE('sss') 1225 1234 zsurfvar(:,:) = tsn(:,:,1,jp_sal) 1226 IF ( ln_output_clim ) zsurfclim(:,:) = zts_dta(:,:,1,jp_sal)1235 IF ( ln_output_clim ) zsurfclim(:,:) = sclim(:,:,1) 1227 1236 CASE('sic') 1228 1237 IF ( kstp == 0 ) THEN -
branches/UKMO/dev_r5518_obs_oper_update_addclim/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90
r11449 r11455 190 190 REAL(KIND=wp), DIMENSION(1) :: zmsk 191 191 REAL(KIND=wp), DIMENSION(:,:,:), ALLOCATABLE :: interp_corner 192 192 REAL(KIND=wp), DIMENSION(:,:,:), ALLOCATABLE :: interp_corner_clim 193 193 194 LOGICAL :: ld_dailyav 194 LOGICAL :: ld_clim195 195 196 196 !------------------------------------------------------------------------ … … 200 200 inrc = kt - kit000 + 2 201 201 ipro = prodatqc%npstp(inrc) 202 203 ! Check if climatology is available and set flag204 IF ( SUM( pclim(:,:,:) ) == 0. ) THEN205 ld_clim = .FALSE.206 ELSE207 ld_clim = .TRUE.208 ENDIF209 202 210 203 ! Daily average types … … 273 266 & ) 274 267 275 IF ( ld_clim ) ALLOCATE( zclim(2,2,kpk,ipro) )268 IF ( prodatqc%lclim ) ALLOCATE( zclim(2,2,kpk,ipro) ) 276 269 277 270 DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro … … 299 292 CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, pgdepw, zgdepw ) 300 293 301 IF ( ld_clim ) THEN294 IF ( prodatqc%lclim ) THEN 302 295 CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, pclim, zclim ) 303 296 ENDIF … … 366 359 inum_obs = iend - ista + 1 367 360 ALLOCATE(interp_corner(2,2,inum_obs),iv_indic(inum_obs)) 368 IF ( ld_clim ) ALLOCATE( interp_corner_clim(2,2,inum_obs) )361 IF ( prodatqc%lclim ) ALLOCATE( interp_corner_clim(2,2,inum_obs) ) 369 362 370 363 DO iin=1,2 … … 377 370 & zmask(iin,ijn,:,iobs)) 378 371 379 IF ( ld_clim ) THEN372 IF ( prodatqc%lclim ) THEN 380 373 CALL obs_int_z1d_spl( kpk, & 381 374 & zclim(iin,ijn,:,iobs), & … … 398 391 & zmask(iin,ijn,:,iobs)) 399 392 400 IF ( ld_clim ) THEN393 IF ( prodatqc%lclim ) THEN 401 394 CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs, & 402 395 & prodatqc%var(kvar)%vdep(ista:iend), & … … 422 415 ALLOCATE( interp_corner(2,2,inum_obs), & 423 416 & iv_indic(inum_obs) ) 424 IF ( ld_clim ) ALLOCATE( interp_corner_clim(2,2,inum_obs) )417 IF ( prodatqc%lclim ) ALLOCATE( interp_corner_clim(2,2,inum_obs) ) 425 418 DO iin=1,2 426 419 DO ijn=1,2 … … 432 425 & zmask(iin,ijn,:,iobs)) 433 426 434 IF ( ld_clim ) THEN427 IF ( prodatqc%lclim ) THEN 435 428 CALL obs_int_z1d_spl( kpk, & 436 429 & zclim(iin,ijn,:,iobs),& … … 453 446 & zmask(iin,ijn,:,iobs) ) 454 447 455 IF ( ld_clim ) THEN448 IF ( prodatqc%lclim ) THEN 456 449 CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs, & 457 450 & prodatqc%var(kvar)%vdep(ista:iend), & … … 504 497 & prodatqc%var(kvar)%vmod(iend:iend) ) 505 498 506 IF ( ld_clim ) THEN499 IF ( prodatqc%lclim ) THEN 507 500 CALL obs_int_h2d( 1, 1, zweig, interp_corner_clim(:,:,ikn), & 508 501 & prodatqc%var(kvar)%vclm(iend:iend) ) … … 516 509 517 510 DEALLOCATE(interp_corner,iv_indic) 518 IF ( ld_clim ) DEALLOCATE( interp_corner_clim )511 IF ( prodatqc%lclim ) DEALLOCATE( interp_corner_clim ) 519 512 520 513 ENDIF … … 534 527 & ) 535 528 536 IF ( ld_clim ) DEALLOCATE( zclim )529 IF ( prodatqc%lclim ) DEALLOCATE( zclim ) 537 530 538 531 ! At the end of the day also get interpolated means … … 650 643 & zmeanday ! to compute model sst in region of 24h daylight (pole) 651 644 652 LOGICAL :: ld_clim ! T => climatological data is available653 645 !------------------------------------------------------------------------ 654 646 ! Local initialization … … 657 649 inrc = kt - kit000 + 2 658 650 isurf = surfdataqc%nsstp(inrc) 659 660 ! Check if climatological information is available661 IF ( SUM(pclim(:,:)) == 0._wp ) THEN662 ld_clim = .FALSE.663 ELSE664 ld_clim = .TRUE.665 ENDIF666 651 667 652 ! Work out the maximum footprint size for the … … 750 735 & ) 751 736 752 IF ( ld_clim ) ALLOCATE( zclim(imaxifp,imaxjfp,isurf) )737 IF ( surfdataqc%lclim ) ALLOCATE( zclim(imaxifp,imaxjfp,isurf) ) 753 738 754 739 DO jobs = surfdataqc%nsurfup + 1, surfdataqc%nsurfup + isurf … … 793 778 & igrdip1, igrdjp1, gphif, zgphif ) 794 779 795 IF ( ld_clim ) THEN780 IF ( surfdataqc%lclim ) THEN 796 781 CALL obs_int_comm_2d( imaxifp, imaxjfp, isurf, kpi, kpj, & 797 782 & igrdi, igrdj, pclim, zclim ) … … 853 838 CALL obs_int_h2d( 1, 1, zweig, zsurftmp(:,:,iobs), zext ) 854 839 855 IF ( ld_clim ) THEN840 IF ( surfdataqc%lclim ) THEN 856 841 CALL obs_int_h2d( 1, 1, zweig, zclim(:,:,iobs), zclm ) 842 IF (lwp) THEN 843 WRITE(numout,*)'zclim: ', iobs, zclim(:,:,iobs), zclm 844 ENDIF 857 845 ENDIF 858 846 … … 871 859 & zweig, zsurftmp(:,:,iobs), zext ) 872 860 873 IF ( ld_clim ) THEN861 IF ( surfdataqc%lclim ) THEN 874 862 CALL obs_avg_h2d( 1, 1, imaxifp, imaxjfp, & 875 863 & zweig, zsurftmp(:,:,iobs), zclm ) … … 886 874 ENDIF 887 875 888 IF ( ld_clim ) surfdataqc%rclm(jobs,1) = zclm(1)876 IF ( surfdataqc%lclim ) surfdataqc%rclm(jobs,1) = zclm(1) 889 877 890 878 IF ( zext(1) == obfillflt ) THEN … … 911 899 & ) 912 900 913 IF ( ld_clim ) DEALLOCATE( zclim )901 IF ( surfdataqc%lclim ) DEALLOCATE( zclim ) 914 902 915 903 ! At the end of the day also deallocate night-time mean array -
branches/UKMO/dev_r5518_obs_oper_update_addclim/NEMOGCM/NEMO/OPA_SRC/OBS/obs_profiles_def.F90
r11449 r11455 73 73 & vobs, & !: Profile data 74 74 & vmod, & !: Model counterpart of the profile data vector 75 & vclm , &!: Climatological counterpart of the profile data vector75 & vclm !: Climatological counterpart of the profile data vector 76 76 77 77 REAL(KIND=wp), POINTER, DIMENSION(:,:) :: & … … 103 103 INTEGER :: nprofup !: Observation counter used in obs_oper 104 104 105 LOGICAL :: lclim !: Climatology will be calculated for this structure 106 105 107 ! Bookkeeping arrays with sizes equal to number of variables 106 108 … … 199 201 200 202 SUBROUTINE obs_prof_alloc( prof, kvar, kext, kprof, & 201 & ko3dt, kstp, kpi, kpj, kpk )203 & ko3dt, kstp, kpi, kpj, kpk, ldclim ) 202 204 !!---------------------------------------------------------------------- 203 205 !! *** ROUTINE obs_prof_alloc *** … … 222 224 INTEGER, INTENT(IN) :: kpj 223 225 INTEGER, INTENT(IN) :: kpk 226 LOGICAL, INTENT(IN) :: ldclim 224 227 225 228 !!* Local variables … … 237 240 prof%npj = kpj 238 241 prof%npk = kpk 242 243 prof%lclim = ldclim 239 244 240 245 ! Allocate arrays of size number of variables … … 493 498 & prof%var(kvar)%vobs(kobs), & 494 499 & prof%var(kvar)%vmod(kobs), & 495 & prof%var(kvar)%vclm(kobs), &496 500 & prof%var(kvar)%nvind(kobs) & 497 501 & ) … … 503 507 ALLOCATE( & 504 508 & prof%var(kvar)%vext(kobs,kext) & 509 & ) 510 ENDIF 511 IF (prof%lclim) THEN 512 ALLOCATE( & 513 & prof%var(kvar)%vclm(kobs) & 505 514 & ) 506 515 ENDIF … … 532 541 & prof%var(kvar)%vobs, & 533 542 & prof%var(kvar)%vmod, & 534 & prof%var(kvar)%vclm, &535 543 & prof%var(kvar)%nvind, & 536 544 & prof%var(kvar)%idqcf, & … … 540 548 DEALLOCATE( & 541 549 & prof%var(kvar)%vext & 550 & ) 551 ENDIF 552 IF (prof%lclim) THEN 553 DEALLOCATE( & 554 & prof%var(kvar)%vclm & 542 555 & ) 543 556 ENDIF … … 633 646 & inprof, invpro, & 634 647 & prof%nstp, prof%npi, & 635 & prof%npj, prof%npk ) 648 & prof%npj, prof%npk, & 649 & prof%lclim ) 636 650 ENDIF 637 651 … … 744 758 newprof%var(jvar)%vmod(invpro(jvar)) = & 745 759 & prof%var(jvar)%vmod(jj) 746 newprof%var(jvar)%vclm(invpro(jvar)) = &747 & prof%var(jvar)%vclm(jj)748 760 DO jext = 1, prof%next 749 761 newprof%var(jvar)%vext(invpro(jvar),jext) = & 750 762 & prof%var(jvar)%vext(jj,jext) 751 763 END DO 752 764 IF (newprof%lclim) THEN 765 newprof%var(jvar)%vclm(invpro(jvar)) = & 766 & prof%var(jvar)%vclm(jj) 767 ENDIF 768 753 769 ! nvind is the index of the original variable data 754 770 … … 869 885 oldprof%var(jvar)%vobs(jl) = prof%var(jvar)%vobs(jj) 870 886 oldprof%var(jvar)%vmod(jl) = prof%var(jvar)%vmod(jj) 871 oldprof%var(jvar)%vclm(jl) = prof%var(jvar)%vclm(jj)872 887 oldprof%var(jvar)%idqcf(:,jl) = prof%var(jvar)%idqcf(:,jj) 873 888 oldprof%var(jvar)%nvqcf(:,jl) = prof%var(jvar)%nvqcf(:,jj) … … 876 891 & prof%var(jvar)%vext(jj,jext) 877 892 END DO 878 893 IF (prof%lclim) THEN 894 oldprof%var(jvar)%vclm(jl) = prof%var(jvar)%vclm(jj) 895 ENDIF 879 896 END DO 880 897 -
branches/UKMO/dev_r5518_obs_oper_update_addclim/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90
r9306 r11455 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 -
branches/UKMO/dev_r5518_obs_oper_update_addclim/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_surf.F90
r9308 r11455 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 -
branches/UKMO/dev_r5518_obs_oper_update_addclim/NEMOGCM/NEMO/OPA_SRC/OBS/obs_surf_def.F90
r11449 r11455 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 … … 125 127 CONTAINS 126 128 127 SUBROUTINE obs_surf_alloc( surf, ksurf, kvar, kextra, kstp, kpi, kpj )129 SUBROUTINE obs_surf_alloc( surf, ksurf, kvar, kextra, kstp, kpi, kpj, ldclim ) 128 130 !!---------------------------------------------------------------------- 129 131 !! *** ROUTINE obs_surf_alloc *** … … 144 146 INTEGER, INTENT(IN) :: kpi ! Number of 3D grid points 145 147 INTEGER, INTENT(IN) :: kpj 148 LOGICAL, INTENT(IN) :: ldclim 146 149 147 150 !!* Local variables … … 158 161 surf%npi = kpi 159 162 surf%npj = kpj 163 surf%lclim = ldclim 160 164 161 165 ! Allocate arrays of size number of variables … … 198 202 ALLOCATE( & 199 203 & surf%robs(ksurf,kvar), & 200 & surf%rmod(ksurf,kvar), & 201 & surf%rclm(ksurf,kvar) & 204 & surf%rmod(ksurf,kvar) & 202 205 & ) 203 206 207 IF (surf%lclim) ALLOCATE( surf%rclm(ksurf,kvar) ) 208 204 209 ! Allocate arrays of number of extra fields at observation points 205 210 … … 292 297 DEALLOCATE( & 293 298 & surf%robs, & 294 & surf%rmod ,&295 & surf%rclm &296 & ) 297 299 & surf%rmod & 300 & ) 301 302 IF (surf%lclim) DEALLOCATE( surf%rclm ) 298 303 ! Deallocate arrays of number of extra fields at observation points 299 304 … … 374 379 IF ( lallocate ) THEN 375 380 CALL obs_surf_alloc( newsurf, insurf, surf%nvar, & 376 & surf%nextra, surf%nstp, surf%npi, surf%npj )381 & surf%nextra, surf%nstp, surf%npi, surf%npj, surf%lclim ) 377 382 ENDIF 378 383 … … 421 426 newsurf%robs(insurf,jk) = surf%robs(ji,jk) 422 427 newsurf%rmod(insurf,jk) = surf%rmod(ji,jk) 423 newsurf%rclm(insurf,jk) = surf%rclm(ji,jk)428 IF (newsurf%lclim) newsurf%rclm(insurf,jk) = surf%rclm(ji,jk) 424 429 425 430 END DO … … 518 523 oldsurf%robs(jj,jk) = surf%robs(ji,jk) 519 524 oldsurf%rmod(jj,jk) = surf%rmod(ji,jk) 520 oldsurf%rclm(jj,jk) = surf%rclm(ji,jk)525 IF (surf%lclim) oldsurf%rclm(jj,jk) = surf%rclm(ji,jk) 521 526 522 527 END DO -
branches/UKMO/dev_r5518_obs_oper_update_addclim/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90
r11449 r11455 29 29 USE obs_mpp ! MPP support routines for observation diagnostics 30 30 USE lib_mpp ! MPP routines 31 USE diaobs, ONLY: &32 & ln_output_clim33 31 34 32 IMPLICIT NONE … … 97 95 INTEGER :: je 98 96 INTEGER :: iadd 99 INTEGER :: iadd_ exp ! expected additional variables97 INTEGER :: iadd_clm ! 1 if climatology present 100 98 INTEGER :: iext 101 99 REAL(wp) :: zpres … … 104 102 ! Set up number of additional variables to be ouput: 105 103 ! Hx, CLIM, ... 106 iadd_ exp = 1 ! Hx107 IF ( ln_output_clim ) iadd_exp = iadd_exp +1104 iadd_clm = 0 105 IF ( profdata%lclim ) iadd_clm = 1 108 106 109 107 IF ( PRESENT( padd ) ) THEN … … 132 130 clfiletype='profb' 133 131 CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, & 134 & iadd_exp+ iadd, 1 + iext, .TRUE. )132 & 1 + iadd_clm + iadd, 1 + iext, .TRUE. ) 135 133 fbdata%cname(1) = profdata%cvars(1) 136 134 fbdata%cname(2) = profdata%cvars(2) … … 148 146 fbdata%caddunit(1,1) = 'Degrees centigrade' 149 147 fbdata%caddunit(1,2) = 'PSU' 150 IF ( ln_output_clim ) THEN148 IF ( profdata%lclim ) THEN 151 149 fbdata%caddlong(2,1) = 'Climatology interpolated potential temperature' 152 150 fbdata%caddlong(2,2) = 'Climatology interpolated practical salinity' … … 161 159 END DO 162 160 DO ja = 1, iadd 163 fbdata%caddname( iadd_exp+ja) = padd%cdname(ja)161 fbdata%caddname(1+iadd_clm+ja) = padd%cdname(ja) 164 162 DO jvar = 1, 2 165 fbdata%caddlong( iadd_exp+ja,jvar) = padd%cdlong(ja,jvar)166 fbdata%caddunit( iadd_exp+ja,jvar) = padd%cdunit(ja,jvar)163 fbdata%caddlong(1+iadd_clm+ja,jvar) = padd%cdlong(ja,jvar) 164 fbdata%caddunit(1+iadd_clm+ja,jvar) = padd%cdunit(ja,jvar) 167 165 END DO 168 166 END DO … … 172 170 clfiletype='velfb' 173 171 CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, & 174 & iadd_exp+ iadd, 0, .TRUE. )172 & 1 + iadd_clm + iadd, 0, .TRUE. ) 175 173 fbdata%cname(1) = profdata%cvars(1) 176 174 fbdata%cname(2) = profdata%cvars(2) … … 188 186 fbdata%caddunit(1,1) = 'm/s' 189 187 fbdata%caddunit(1,2) = 'm/s' 190 IF ( ln_output_clim ) THEN188 IF ( profdata%lclim ) THEN 191 189 fbdata%caddlong(2,1) = 'Climatology interpolated zonal velocity' 192 190 fbdata%caddlong(2,2) = 'Climatology interpolated meridional velocity' … … 197 195 fbdata%cgrid(2) = 'V' 198 196 DO ja = 1, iadd 199 fbdata%caddname( iadd_exp+ja) = padd%cdname(ja)200 fbdata%caddlong( iadd_exp+ja,1) = padd%cdlong(ja,1)201 fbdata%caddunit( iadd_exp+ja,1) = padd%cdunit(ja,1)197 fbdata%caddname(1+iadd_clm+ja) = padd%cdname(ja) 198 fbdata%caddlong(1+iadd_clm+ja,1) = padd%cdlong(ja,1) 199 fbdata%caddunit(1+iadd_clm+ja,1) = padd%cdunit(ja,1) 202 200 END DO 203 201 … … 270 268 & ( TRIM(profdata%cvars(1)) /= 'UVEL' ) ) THEN 271 269 CALL alloc_obfbdata( fbdata, 1, profdata%nprof, ilevel, & 272 & iadd_expt+ iadd, iext, .TRUE. )270 & 1 + iadd_clm + iadd, iext, .TRUE. ) 273 271 fbdata%cname(1) = profdata%cvars(1) 274 272 fbdata%coblong(1) = cllongname … … 276 274 fbdata%caddlong(1,1) = 'Model interpolated ' // TRIM(cllongname) 277 275 fbdata%caddunit(1,1) = clunits 278 IF ( ln_output_clim ) THEN276 IF ( profdata%lclim ) THEN 279 277 fbdata%caddlong(2,1) = 'Climatological interpolated ' // TRIM(cllongname) 280 278 fbdata%caddunit(2,1) = clunits … … 287 285 END DO 288 286 DO ja = 1, iadd 289 fbdata%caddname( iadd_expt+ja) = padd%cdname(ja)290 fbdata%caddlong( iadd_expt+ja,1) = padd%cdlong(ja,1)291 fbdata%caddunit( iadd_expt+ja,1) = padd%cdunit(ja,1)287 fbdata%caddname(1+iadd_clm+ja) = padd%cdname(ja) 288 fbdata%caddlong(1+iadd_clm+ja,1) = padd%cdlong(ja,1) 289 fbdata%caddunit(1+iadd_clm+ja,1) = padd%cdunit(ja,1) 292 290 END DO 293 291 ENDIF 294 292 295 293 fbdata%caddname(1) = 'Hx' 296 IF ( ln_output_clim ) fbdata%caddname(2) = 'CLM'294 IF ( profdata%lclim ) fbdata%caddname(1+iadd_clm) = 'CLM' 297 295 298 296 WRITE(clfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(clfiletype), nproc … … 348 346 DO jk = profdata%npvsta(jo,jvar), profdata%npvend(jo,jvar) 349 347 ik = profdata%var(jvar)%nvlidx(jk) 350 fbdata%padd(ik,jo,1,jvar) = profdata%var(jvar)%vmod(jk)351 IF ( ln_output_clim ) THEN352 fbdata%padd(ik,jo,2,jvar) = profdata%var(jvar)%vclm(jk)353 ENDIF354 348 fbdata%pob(ik,jo,jvar) = profdata%var(jvar)%vobs(jk) 355 349 fbdata%pdep(ik,jo) = profdata%var(jvar)%vdep(jk) … … 365 359 ENDIF 366 360 fbdata%iobsk(ik,jo,jvar) = profdata%var(jvar)%mvk(jk) 361 362 fbdata%padd(ik,jo,1,jvar) = profdata%var(jvar)%vmod(jk) 363 IF ( profdata%lclim ) THEN 364 fbdata%padd(ik,jo,1+iadd_clm,jvar) = profdata%var(jvar)%vclm(jk) 365 ENDIF 367 366 DO ja = 1, iadd 368 fbdata%padd(ik,jo, iadd_exp+ja,jvar) = &367 fbdata%padd(ik,jo,1+iadd_clm+ja,jvar) = & 369 368 & profdata%var(jvar)%vext(jk,padd%ipoint(ja)) 370 369 END DO … … 449 448 INTEGER :: je 450 449 INTEGER :: iadd 451 INTEGER :: iadd_exp452 450 INTEGER :: iext 453 451 INTEGER :: indx_std 454 452 INTEGER :: iadd_std 455 INTEGER :: iadd_clm 453 INTEGER :: iadd_clm 454 INTEGER :: iadd_mdt 455 456 IF ( PRESENT( pext ) ) THEN 457 iext = pext%inum 458 ELSE 459 iext = 0 460 ENDIF 456 461 457 462 458 463 ! Set up number of additional variables to be ouput: 459 ! Hx, CLIM, ... 460 iadd_exp = 1 ! Hx 461 IF ( ln_output_clim ) iadd_exp = iadd_exp + 1 464 ! Hx, CLM, STD, MDT... 462 465 463 466 IF ( PRESENT( padd ) ) THEN … … 466 469 iadd = 0 467 470 ENDIF 468 469 IF ( PRESENT( pext ) ) THEN 470 iext = pext%inum 471 ELSE 472 iext = 0 473 ENDIF 474 471 475 472 iadd_std = 0 476 473 indx_std = -1 … … 485 482 486 483 iadd_clm = 0 484 IF ( surfdata%lclim ) iadd_clm = 1 485 486 iadd_mdt = 0 487 IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) iadd_mdt = 1 487 488 488 489 CALL init_obfbdata( fbdata ) … … 496 497 497 498 CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 498 & 2 + iadd + iadd_std, 1 + iext, .TRUE. ) 499 & 1 + iadd_mdt + iadd_std + iadd, & 500 & 1 + iext, .TRUE. ) 499 501 500 502 clfiletype = 'slafb' … … 517 519 fbdata%cgrid(1) = 'T' 518 520 DO ja = 1, iadd 519 fbdata%caddname( 2+iadd_std+ja) = padd%cdname(ja)520 fbdata%caddlong( 2+iadd_std+ja,1) = padd%cdlong(ja,1)521 fbdata%caddunit( 2+iadd_std+ja,1) = padd%cdunit(ja,1)521 fbdata%caddname(1+iadd_mdt+iadd_std+ja) = padd%cdname(ja) 522 fbdata%caddlong(1+iadd_mdt+iadd_std+ja,1) = padd%cdlong(ja,1) 523 fbdata%caddunit(1+iadd_mdt+iadd_std+ja,1) = padd%cdunit(ja,1) 522 524 END DO 523 525 … … 528 530 clunits = 'Degree centigrade' 529 531 clgrid = 'T' 530 IF ( ln_output_clim ) iadd_clm = 1531 532 532 533 CASE('ICECONC') … … 543 544 clunits = 'psu' 544 545 clgrid = 'T' 545 IF ( ln_output_clim ) iadd_clm = 1546 546 547 547 CASE('SLCHLTOT','LOGCHL','LogChl','logchl') … … 655 655 656 656 CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 657 & 1 + iadd + iadd_std + iadd_clm, iext, .TRUE. )657 & 1 + iadd_std + iadd_clm + iadd, iext, .TRUE. ) 658 658 659 659 fbdata%cname(1) = surfdata%cvars(1) … … 673 673 fbdata%cgrid(1) = clgrid 674 674 DO ja = 1, iadd 675 fbdata%caddname(1+iadd_ std+iadd_clm+ja) = padd%cdname(ja)676 fbdata%caddlong(1+iadd_ std+iadd_clm+ja,1) = padd%cdlong(ja,1)677 fbdata%caddunit(1+iadd_ std+iadd_clm+ja,1) = padd%cdunit(ja,1)675 fbdata%caddname(1+iadd_mdt+iadd_std+iadd_clm+ja) = padd%cdname(ja) 676 fbdata%caddlong(1+iadd_mdt+iadd_std+iadd_clm+ja,1) = padd%cdlong(ja,1) 677 fbdata%caddunit(1+iadd_mdt+iadd_std+iadd_clm+ja,1) = padd%cdunit(ja,1) 678 678 END DO 679 679 … … 682 682 fbdata%caddname(1) = 'Hx' 683 683 IF ( indx_std /= -1 ) THEN 684 IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) iadd_std = iadd_std + 1 685 fbdata%caddname(1+iadd_std) = surfdata%cext(indx_std) 686 fbdata%caddlong(1+iadd_std,1) = 'Obs error standard deviation' 687 fbdata%caddunit(1+iadd_std,1) = fbdata%cobunit(1) 688 ENDIF 689 690 IF ( ln_output_clim .AND. ( iadd_clm > 0 ) ) THEN 691 fbdata%caddname(1+iadd_std+iadd_clm) = 'CLM' 692 fbdata%caddlong(1+iadd_std+iadd_clm,1) = 'Climatology' 693 fbdata%caddunit(1+iadd_std+iadd_clm,1) = fbdata%cobunit(1) 684 fbdata%caddname(1+iadd_mdt+iadd_std) = surfdata%cext(indx_std) 685 fbdata%caddlong(1+iadd_mdt+iadd_std,1) = 'Obs error standard deviation' 686 fbdata%caddunit(1+iadd_mdt+iadd_std,1) = fbdata%cobunit(1) 687 ENDIF 688 689 IF ( surfdata%lclim ) THEN 690 fbdata%caddname(1+iadd_mdt+iadd_std+iadd_clm) = 'CLM' 691 fbdata%caddlong(1+iadd_mdt+iadd_std+iadd_clm,1) = 'Climatology' 692 fbdata%caddunit(1+iadd_mdt+iadd_std+iadd_clm,1) = fbdata%cobunit(1) 694 693 ENDIF 695 694 … … 741 740 & fbdata%ptim(jo), & 742 741 & krefdate = 19500101 ) 743 fbdata%padd(1,jo,1,1) = surfdata%rmod(jo,1) 744 IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) THEN 745 fbdata%padd(1,jo,2,1) = surfdata%rext(jo,1) 746 ENDIF 747 IF ( ln_output_clim .AND. ( iadd_clm > 0 ) ) THEN 748 fbdata%padd(1,jo,2,1) = surfdata%rclm(jo,1) 749 ENDIF 750 742 751 743 fbdata%pob(1,jo,1) = surfdata%robs(jo,1) 752 744 fbdata%pdep(1,jo) = 0.0 … … 764 756 ENDIF 765 757 fbdata%iobsk(1,jo,1) = 0 766 IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) fbdata%pext(1,jo,1) = surfdata%rext(jo,2) 758 759 ! Additional variables. 760 ! Hx is always the first additional variable 761 fbdata%padd(1,jo,1,1) = surfdata%rmod(jo,1) 762 ! MDT is output as an additional variable if SLA obs type 763 IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) THEN 764 fbdata%padd(1,jo,1+iadd_mdt,1) = surfdata%rext(jo,1) 765 ENDIF 766 ! STD is output as an additional variable if available 767 767 IF ( indx_std /= -1 ) THEN 768 fbdata%padd(1,jo,1+iadd_ std,1) = surfdata%rext(jo,indx_std)768 fbdata%padd(1,jo,1+iadd_mdt+iadd_std,1) = surfdata%rext(jo,indx_std) 769 769 ENDIF 770 ! CLM is output as an additional variable if available 771 IF ( surfdata%lclim ) THEN 772 fbdata%padd(1,jo,1+iadd_mdt+iadd_std+iadd_clm,1) = surfdata%rclm(jo,1) 773 ENDIF 774 ! Then other additional variables are output 775 DO ja = 1, iadd 776 fbdata%padd(1,jo,1+iadd_mdt+iadd_std+iadd_clm+ja,1) = & 777 & surfdata%rext(jo,padd%ipoint(ja)) 778 END DO 770 779 771 DO ja = 1, iadd 772 fbdata%padd(1,jo,2+iadd_std+ja,1) = & 773 & surfdata%rext(jo,padd%ipoint(ja)) 774 END DO 780 ! Extra variables 781 IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) fbdata%pext(1,jo,1) = surfdata%rext(jo,2) 775 782 DO je = 1, iext 776 783 fbdata%pext(1,jo,1+je) = & -
branches/UKMO/dev_r5518_obs_oper_update_addclim/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90
r7960 r11455 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.