Changeset 11449
- Timestamp:
- 2019-08-19T10:54:47+02:00 (5 years ago)
- Location:
- branches/UKMO/dev_r5518_obs_oper_update_addclim/NEMOGCM/NEMO/OPA_SRC/OBS
- Files:
-
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_obs_oper_update_addclim/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
r11235 r11449 33 33 USE mpp_map ! MPP mapping 34 34 USE lib_mpp ! For ctl_warn/stop 35 USE dtatsd ! For climatological temperature & salinity 36 USE tradmp ! "" 35 37 36 38 IMPLICIT NONE … … 48 50 LOGICAL :: ln_diaobs !: Logical switch for the obs operator 49 51 LOGICAL :: ln_sstnight !: Logical switch for night mean SST obs 52 LOGICAL :: ln_output_clim !: Logical switch for interpolating and outputting T/S climatology 50 53 LOGICAL :: ln_default_fp_indegs !: T=> Default obs footprint size specified in degrees, F=> in metres 51 54 LOGICAL :: ln_sla_fp_indegs !: T=> SLA obs footprint size specified in degrees, F=> in metres … … 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 ob locs 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 … … 926 940 REAL(wp) :: tiny ! small number 927 941 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: & 928 & zprofvar ! Model values for variables in a prof ob 942 & zprofvar, & ! Model values for variables in a prof ob 943 & zprofclim ! Climatology values for variables in a prof ob 929 944 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: & 930 945 & zprofmask ! Mask associated with zprofvar 931 946 REAL(wp), POINTER, DIMENSION(:,:) :: & 932 947 & zsurfvar, & ! Model values equivalent to surface ob. 948 & zsurfclim, & ! Climatology values for variables in a surface ob. 933 949 & zsurfmask ! Mask associated with surface variable 934 950 REAL(wp), POINTER, DIMENSION(:,:,:) :: & … … 940 956 & pco2_3d ! 3D pCO2 from FABM 941 957 #endif 942 958 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zts_dta 959 943 960 IF(lwp) THEN 944 961 WRITE(numout,*) … … 950 967 idaystp = NINT( rday / rdt ) 951 968 969 ! Get the climatological T & S fields on this time step 970 IF ( ln_output_clim ) CALL dta_tsd( kstp, zts_dta ) 971 952 972 !----------------------------------------------------------------------- 953 973 ! Call the profile and surface observation operators … … 963 983 CALL wrk_alloc( jpi, jpj, profdataqc(jtype)%nvar, zglam ) 964 984 CALL wrk_alloc( jpi, jpj, profdataqc(jtype)%nvar, zgphi ) 965 985 CALL wrk_alloc( jpi, jpj, jpk, profdataqc(jtype)%nvar, zprofclim ) 986 966 987 ! Defaults which might change 967 988 DO jvar = 1, profdataqc(jtype)%nvar … … 969 990 zglam(:,:,jvar) = glamt(:,:) 970 991 zgphi(:,:,jvar) = gphit(:,:) 992 zprofclim(:,:,:,jvar) = 0._wp 971 993 END DO 972 994 … … 976 998 zprofvar(:,:,:,1) = tsn(:,:,:,jp_tem) 977 999 zprofvar(:,:,:,2) = tsn(:,:,:,jp_sal) 978 1000 IF ( ln_output_clim ) THEN 1001 zprofclim(:,:,:,1) = zts_dta(:,:,:,jp_tem) 1002 zprofclim(:,:,:,2) = zts_dta(:,:,:,jp_sal) 1003 ENDIF 1004 979 1005 CASE('vel') 980 1006 zprofvar(:,:,:,1) = un(:,:,:) … … 1155 1181 & nit000, idaystp, jvar, & 1156 1182 & zprofvar(:,:,:,jvar), & 1183 & zprofclim(:,:,:,jvar), & 1157 1184 & fsdept(:,:,:), fsdepw(:,:,:), & 1158 1185 & zprofmask(:,:,:,jvar), & … … 1166 1193 CALL wrk_dealloc( jpi, jpj, profdataqc(jtype)%nvar, zglam ) 1167 1194 CALL wrk_dealloc( jpi, jpj, profdataqc(jtype)%nvar, zgphi ) 1195 CALL wrk_dealloc( jpi, jpj, jpk, profdataqc(jtype)%nvar, zprofclim ) 1168 1196 1169 1197 END DO … … 1175 1203 !Allocate local work arrays 1176 1204 CALL wrk_alloc( jpi, jpj, zsurfvar ) 1205 CALL wrk_alloc( jpi, jpj, zsurfclim ) 1177 1206 CALL wrk_alloc( jpi, jpj, zsurfmask ) 1178 1207 #if defined key_fabm … … 1184 1213 !Defaults which might be changed 1185 1214 zsurfmask(:,:) = tmask(:,:,1) 1215 zsurfclim(:,:) = 0._wp 1186 1216 llog10 = .FALSE. 1187 1217 … … 1189 1219 CASE('sst') 1190 1220 zsurfvar(:,:) = tsn(:,:,1,jp_tem) 1221 IF ( ln_output_clim ) zsurfclim(:,:) = zts_dta(:,:,1,jp_tem) 1191 1222 CASE('sla') 1192 zsurfvar(:,:) = sshn(:,:)1223 zsurfvar(:,:) = sshn(:,:) 1193 1224 CASE('sss') 1194 1225 zsurfvar(:,:) = tsn(:,:,1,jp_sal) 1226 IF ( ln_output_clim ) zsurfclim(:,:) = zts_dta(:,:,1,jp_sal) 1195 1227 CASE('sic') 1196 1228 IF ( kstp == 0 ) THEN … … 1485 1517 1486 1518 CALL obs_surf_opt( surfdataqc(jtype), kstp, jpi, jpj, & 1487 & nit000, idaystp, zsurfvar, zsurfmask, & 1519 & nit000, idaystp, zsurfvar, & 1520 & zsurfclim, zsurfmask, & 1488 1521 & n2dintsurf(jtype), llnightav(jtype), & 1489 & ravglamscl(jtype), ravgphiscl(jtype), 1522 & ravglamscl(jtype), ravgphiscl(jtype), & 1490 1523 & lfpindegs(jtype) ) 1491 1524 -
branches/UKMO/dev_r5518_obs_oper_update_addclim/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90
r9306 r11449 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, & … … 189 192 190 193 LOGICAL :: ld_dailyav 194 LOGICAL :: ld_clim 191 195 192 196 !------------------------------------------------------------------------ … … 196 200 inrc = kt - kit000 + 2 197 201 ipro = prodatqc%npstp(inrc) 202 203 ! Check if climatology is available and set flag 204 IF ( SUM( pclim(:,:,:) ) == 0. ) THEN 205 ld_clim = .FALSE. 206 ELSE 207 ld_clim = .TRUE. 208 ENDIF 198 209 199 210 ! Daily average types … … 262 273 & ) 263 274 275 IF ( ld_clim ) ALLOCATE( zclim(2,2,kpk,ipro) ) 276 264 277 DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro 265 278 iobs = jobs - prodatqc%nprofup … … 286 299 CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, pgdepw, zgdepw ) 287 300 301 IF ( ld_clim ) THEN 302 CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, pclim, zclim ) 303 ENDIF 304 288 305 ! At the end of the day also get interpolated means 289 306 IF ( ld_dailyav .AND. idayend == 0 ) THEN … … 349 366 inum_obs = iend - ista + 1 350 367 ALLOCATE(interp_corner(2,2,inum_obs),iv_indic(inum_obs)) 351 368 IF ( ld_clim ) ALLOCATE( interp_corner_clim(2,2,inum_obs) ) 369 352 370 DO iin=1,2 353 371 DO ijn=1,2 … … 358 376 & zobs2k, zgdept(iin,ijn,:,iobs), & 359 377 & zmask(iin,ijn,:,iobs)) 378 379 IF ( ld_clim ) THEN 380 CALL obs_int_z1d_spl( kpk, & 381 & zclim(iin,ijn,:,iobs), & 382 & zclm2k, zgdept(iin,ijn,:,iobs), & 383 & zmask(iin,ijn,:,iobs)) 384 ENDIF 385 360 386 ENDIF 361 387 … … 371 397 & zgdept(iin,ijn,:,iobs), & 372 398 & zmask(iin,ijn,:,iobs)) 373 399 400 IF ( ld_clim ) THEN 401 CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs, & 402 & prodatqc%var(kvar)%vdep(ista:iend), & 403 & zclim(iin,ijn,:,iobs), & 404 & zclm2k, interp_corner_clim(iin,ijn,:), & 405 & zgdept(iin,ijn,:,iobs), & 406 & zmask(iin,ijn,:,iobs)) 407 ENDIF 408 374 409 ENDDO 375 410 ENDDO … … 385 420 iend = prodatqc%npvend(jobs,kvar) 386 421 inum_obs = iend - ista + 1 387 ALLOCATE(interp_corner(2,2,inum_obs), iv_indic(inum_obs)) 422 ALLOCATE( interp_corner(2,2,inum_obs), & 423 & iv_indic(inum_obs) ) 424 IF ( ld_clim ) ALLOCATE( interp_corner_clim(2,2,inum_obs) ) 388 425 DO iin=1,2 389 426 DO ijn=1,2 … … 394 431 & zobs2k, zgdept(iin,ijn,:,iobs), & 395 432 & zmask(iin,ijn,:,iobs)) 433 434 IF ( ld_clim ) THEN 435 CALL obs_int_z1d_spl( kpk, & 436 & zclim(iin,ijn,:,iobs),& 437 & zclm2k, zgdept(iin,ijn,:,iobs), & 438 & zmask(iin,ijn,:,iobs)) 439 ENDIF 396 440 397 441 ENDIF … … 408 452 & zgdept(iin,ijn,:,iobs), & 409 453 & zmask(iin,ijn,:,iobs) ) 454 455 IF ( ld_clim ) THEN 456 CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs, & 457 & prodatqc%var(kvar)%vdep(ista:iend), & 458 & zclim(iin,ijn,:,iobs), & 459 & zclm2k,interp_corner_clim(iin,ijn,:), & 460 & zgdept(iin,ijn,:,iobs), & 461 & zmask(iin,ijn,:,iobs) ) 462 ENDIF 410 463 411 464 ENDDO … … 451 504 & prodatqc%var(kvar)%vmod(iend:iend) ) 452 505 506 IF ( ld_clim ) THEN 507 CALL obs_int_h2d( 1, 1, zweig, interp_corner_clim(:,:,ikn), & 508 & prodatqc%var(kvar)%vclm(iend:iend) ) 509 ENDIF 510 453 511 ! Set QC flag for any observations found below the bottom 454 512 ! needed as the check here is more strict than that in obs_prep … … 458 516 459 517 DEALLOCATE(interp_corner,iv_indic) 460 518 IF ( ld_clim ) DEALLOCATE( interp_corner_clim ) 519 461 520 ENDIF 462 521 … … 475 534 & ) 476 535 536 IF ( ld_clim ) DEALLOCATE( zclim ) 537 477 538 ! At the end of the day also get interpolated means 478 539 IF ( ld_dailyav .AND. idayend == 0 ) THEN … … 487 548 488 549 SUBROUTINE obs_surf_opt( surfdataqc, kt, kpi, kpj, & 489 & kit000, kdaystp, psurf, p surfmask, &550 & kit000, kdaystp, psurf, pclim, psurfmask, & 490 551 & k2dint, ldnightav, plamscl, pphiscl, & 491 552 & lindegrees ) … … 541 602 REAL(wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 542 603 & psurf, & ! Model surface field 604 & pclim, & ! Climatological surface field 543 605 & psurfmask ! Land-sea mask 544 606 LOGICAL, INTENT(IN) :: ldnightav ! Logical for averaging night-time data … … 569 631 REAL(wp) :: zlam 570 632 REAL(wp) :: zphi 571 REAL(wp), DIMENSION(1) :: zext, zobsmask 633 REAL(wp), DIMENSION(1) :: zext, zobsmask, zclm 572 634 REAL(wp) :: zdaystp 573 635 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & … … 577 639 & zsurfm, & 578 640 & zsurftmp, & 641 & zclim, & 579 642 & zglam, & 580 643 & zgphi, & … … 586 649 & zouttmp, & 587 650 & zmeanday ! to compute model sst in region of 24h daylight (pole) 588 651 652 LOGICAL :: ld_clim ! T => climatological data is available 589 653 !------------------------------------------------------------------------ 590 654 ! Local initialization … … 593 657 inrc = kt - kit000 + 2 594 658 isurf = surfdataqc%nsstp(inrc) 659 660 ! Check if climatological information is available 661 IF ( SUM(pclim(:,:)) == 0._wp ) THEN 662 ld_clim = .FALSE. 663 ELSE 664 ld_clim = .TRUE. 665 ENDIF 595 666 596 667 ! Work out the maximum footprint size for the … … 679 750 & ) 680 751 752 IF ( ld_clim ) ALLOCATE( zclim(imaxifp,imaxjfp,isurf) ) 753 681 754 DO jobs = surfdataqc%nsurfup + 1, surfdataqc%nsurfup + isurf 682 755 iobs = jobs - surfdataqc%nsurfup … … 720 793 & igrdip1, igrdjp1, gphif, zgphif ) 721 794 795 IF ( ld_clim ) THEN 796 CALL obs_int_comm_2d( imaxifp, imaxjfp, isurf, kpi, kpj, & 797 & igrdi, igrdj, pclim, zclim ) 798 ENDIF 799 722 800 ! At the end of the day get interpolated means 723 801 IF ( idayend == 0 .AND. ldnightav ) THEN … … 775 853 CALL obs_int_h2d( 1, 1, zweig, zsurftmp(:,:,iobs), zext ) 776 854 855 IF ( ld_clim ) THEN 856 CALL obs_int_h2d( 1, 1, zweig, zclim(:,:,iobs), zclm ) 857 ENDIF 858 859 777 860 ELSE 778 861 … … 788 871 & zweig, zsurftmp(:,:,iobs), zext ) 789 872 873 IF ( ld_clim ) THEN 874 CALL obs_avg_h2d( 1, 1, imaxifp, imaxjfp, & 875 & zweig, zsurftmp(:,:,iobs), zclm ) 876 ENDIF 877 790 878 ENDIF 791 879 … … 797 885 surfdataqc%rmod(jobs,1) = zext(1) 798 886 ENDIF 887 888 IF ( ld_clim ) surfdataqc%rclm(jobs,1) = zclm(1) 799 889 800 890 IF ( zext(1) == obfillflt ) THEN … … 821 911 & ) 822 912 913 IF ( ld_clim ) DEALLOCATE( zclim ) 914 823 915 ! At the end of the day also deallocate night-time mean array 824 916 IF ( idayend == 0 .AND. ldnightav ) THEN -
branches/UKMO/dev_r5518_obs_oper_update_addclim/NEMOGCM/NEMO/OPA_SRC/OBS/obs_profiles_def.F90
r7992 r11449 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 … … 492 493 & prof%var(kvar)%vobs(kobs), & 493 494 & prof%var(kvar)%vmod(kobs), & 495 & prof%var(kvar)%vclm(kobs), & 494 496 & prof%var(kvar)%nvind(kobs) & 495 497 & ) … … 530 532 & prof%var(kvar)%vobs, & 531 533 & prof%var(kvar)%vmod, & 534 & prof%var(kvar)%vclm, & 532 535 & prof%var(kvar)%nvind, & 533 536 & prof%var(kvar)%idqcf, & … … 741 744 newprof%var(jvar)%vmod(invpro(jvar)) = & 742 745 & prof%var(jvar)%vmod(jj) 746 newprof%var(jvar)%vclm(invpro(jvar)) = & 747 & prof%var(jvar)%vclm(jj) 743 748 DO jext = 1, prof%next 744 749 newprof%var(jvar)%vext(invpro(jvar),jext) = & … … 864 869 oldprof%var(jvar)%vobs(jl) = prof%var(jvar)%vobs(jj) 865 870 oldprof%var(jvar)%vmod(jl) = prof%var(jvar)%vmod(jj) 871 oldprof%var(jvar)%vclm(jl) = prof%var(jvar)%vclm(jj) 866 872 oldprof%var(jvar)%idqcf(:,jl) = prof%var(jvar)%idqcf(:,jj) 867 873 oldprof%var(jvar)%nvqcf(:,jl) = prof%var(jvar)%nvqcf(:,jj) -
branches/UKMO/dev_r5518_obs_oper_update_addclim/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90
r7992 r11449 37 37 REAL(wp), PUBLIC :: rn_mdtcorr = 1.61_wp ! User specified MDT correction 38 38 REAL(wp), PUBLIC :: rn_mdtcutoff = 65.0_wp ! MDT cutoff for computed correction 39 39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mdt_fld !: Mean Dynamic Topography on the model grid 40 40 41 !!---------------------------------------------------------------------- 41 42 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 92 93 CALL iom_get ( nummdt, jpdom_data, 'sossheig', z_mdt(:,:), 1 ) 93 94 CALL iom_close(nummdt) ! Close the file 95 96 ! Set the MDT gridded field to be the one read in directly with no adjustments 97 ALLOCATE( mdt_fld(jpi,jpj) ) 98 mdt_fld(:,:) = z_mdt(:,:) 94 99 95 100 ! Read in the fill value -
branches/UKMO/dev_r5518_obs_oper_update_addclim/NEMOGCM/NEMO/OPA_SRC/OBS/obs_surf_def.F90
r9308 r11449 84 84 REAL(KIND=wp), POINTER, DIMENSION(:,:) :: & 85 85 & robs, & !: Surface observation 86 & rmod !: Model counterpart of the surface observation vector 87 86 & rmod, & !: Model counterpart of the surface observation vector 87 & rclm !: Climatological counterpart of the surface observation vector 88 88 89 REAL(KIND=wp), POINTER, DIMENSION(:,:) :: & 89 90 & rext !: Extra fields interpolated to observation points … … 197 198 ALLOCATE( & 198 199 & surf%robs(ksurf,kvar), & 199 & surf%rmod(ksurf,kvar) & 200 & surf%rmod(ksurf,kvar), & 201 & surf%rclm(ksurf,kvar) & 200 202 & ) 201 203 … … 290 292 DEALLOCATE( & 291 293 & surf%robs, & 292 & surf%rmod & 294 & surf%rmod, & 295 & surf%rclm & 293 296 & ) 294 297 … … 418 421 newsurf%robs(insurf,jk) = surf%robs(ji,jk) 419 422 newsurf%rmod(insurf,jk) = surf%rmod(ji,jk) 423 newsurf%rclm(insurf,jk) = surf%rclm(ji,jk) 420 424 421 425 END DO … … 514 518 oldsurf%robs(jj,jk) = surf%robs(ji,jk) 515 519 oldsurf%rmod(jj,jk) = surf%rmod(ji,jk) 520 oldsurf%rclm(jj,jk) = surf%rclm(ji,jk) 516 521 517 522 END DO -
branches/UKMO/dev_r5518_obs_oper_update_addclim/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90
r9308 r11449 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_clim 31 33 32 34 IMPLICIT NONE … … 95 97 INTEGER :: je 96 98 INTEGER :: iadd 99 INTEGER :: iadd_exp ! expected additional variables 97 100 INTEGER :: iext 98 101 REAL(wp) :: zpres 99 102 103 104 ! Set up number of additional variables to be ouput: 105 ! Hx, CLIM, ... 106 iadd_exp = 1 ! Hx 107 IF ( ln_output_clim ) iadd_exp = iadd_exp + 1 108 100 109 IF ( PRESENT( padd ) ) THEN 101 110 iadd = padd%inum … … 123 132 clfiletype='profb' 124 133 CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, & 125 & 1+ iadd, 1 + iext, .TRUE. )134 & iadd_exp + iadd, 1 + iext, .TRUE. ) 126 135 fbdata%cname(1) = profdata%cvars(1) 127 136 fbdata%cname(2) = profdata%cvars(2) … … 130 139 fbdata%cobunit(1) = 'Degrees centigrade' 131 140 fbdata%cobunit(2) = 'PSU' 141 132 142 fbdata%cextname(1) = 'TEMP' 133 143 fbdata%cextlong(1) = 'Insitu temperature' 134 144 fbdata%cextunit(1) = 'Degrees centigrade' 145 135 146 fbdata%caddlong(1,1) = 'Model interpolated potential temperature' 136 147 fbdata%caddlong(1,2) = 'Model interpolated practical salinity' 137 148 fbdata%caddunit(1,1) = 'Degrees centigrade' 138 149 fbdata%caddunit(1,2) = 'PSU' 150 IF ( ln_output_clim ) THEN 151 fbdata%caddlong(2,1) = 'Climatology interpolated potential temperature' 152 fbdata%caddlong(2,2) = 'Climatology interpolated practical salinity' 153 fbdata%caddunit(2,1) = 'Degrees centigrade' 154 fbdata%caddunit(2,2) = 'PSU' 155 ENDIF 139 156 fbdata%cgrid(:) = 'T' 140 157 DO je = 1, iext … … 144 161 END DO 145 162 DO ja = 1, iadd 146 fbdata%caddname( 1+ja) = padd%cdname(ja)163 fbdata%caddname(iadd_exp+ja) = padd%cdname(ja) 147 164 DO jvar = 1, 2 148 fbdata%caddlong( 1+ja,jvar) = padd%cdlong(ja,jvar)149 fbdata%caddunit( 1+ja,jvar) = padd%cdunit(ja,jvar)165 fbdata%caddlong(iadd_exp+ja,jvar) = padd%cdlong(ja,jvar) 166 fbdata%caddunit(iadd_exp+ja,jvar) = padd%cdunit(ja,jvar) 150 167 END DO 151 168 END DO … … 154 171 155 172 clfiletype='velfb' 156 CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, 1, 0, .TRUE. ) 173 CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, & 174 & iadd_exp + iadd, 0, .TRUE. ) 157 175 fbdata%cname(1) = profdata%cvars(1) 158 176 fbdata%cname(2) = profdata%cvars(2) … … 170 188 fbdata%caddunit(1,1) = 'm/s' 171 189 fbdata%caddunit(1,2) = 'm/s' 190 IF ( ln_output_clim ) THEN 191 fbdata%caddlong(2,1) = 'Climatology interpolated zonal velocity' 192 fbdata%caddlong(2,2) = 'Climatology interpolated meridional velocity' 193 fbdata%caddunit(2,1) = 'm/s' 194 fbdata%caddunit(2,2) = 'm/s' 195 ENDIF 172 196 fbdata%cgrid(1) = 'U' 173 197 fbdata%cgrid(2) = 'V' 174 198 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)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) 178 202 END DO 179 203 … … 246 270 & ( TRIM(profdata%cvars(1)) /= 'UVEL' ) ) THEN 247 271 CALL alloc_obfbdata( fbdata, 1, profdata%nprof, ilevel, & 248 & 1+ iadd, iext, .TRUE. )272 & iadd_expt + iadd, iext, .TRUE. ) 249 273 fbdata%cname(1) = profdata%cvars(1) 250 274 fbdata%coblong(1) = cllongname … … 252 276 fbdata%caddlong(1,1) = 'Model interpolated ' // TRIM(cllongname) 253 277 fbdata%caddunit(1,1) = clunits 278 IF ( ln_output_clim ) THEN 279 fbdata%caddlong(2,1) = 'Climatological interpolated ' // TRIM(cllongname) 280 fbdata%caddunit(2,1) = clunits 281 ENDIF 254 282 fbdata%cgrid(:) = clgrid 255 283 DO je = 1, iext … … 259 287 END DO 260 288 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)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) 264 292 END DO 265 293 ENDIF 266 294 267 295 fbdata%caddname(1) = 'Hx' 268 296 IF ( ln_output_clim ) fbdata%caddname(2) = 'CLM' 297 269 298 WRITE(clfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(clfiletype), nproc 270 299 … … 320 349 ik = profdata%var(jvar)%nvlidx(jk) 321 350 fbdata%padd(ik,jo,1,jvar) = profdata%var(jvar)%vmod(jk) 351 IF ( ln_output_clim ) THEN 352 fbdata%padd(ik,jo,2,jvar) = profdata%var(jvar)%vclm(jk) 353 ENDIF 322 354 fbdata%pob(ik,jo,jvar) = profdata%var(jvar)%vobs(jk) 323 355 fbdata%pdep(ik,jo) = profdata%var(jvar)%vdep(jk) … … 334 366 fbdata%iobsk(ik,jo,jvar) = profdata%var(jvar)%mvk(jk) 335 367 DO ja = 1, iadd 336 fbdata%padd(ik,jo, 1+ja,jvar) = &368 fbdata%padd(ik,jo,iadd_exp+ja,jvar) = & 337 369 & profdata%var(jvar)%vext(jk,padd%ipoint(ja)) 338 370 END DO … … 417 449 INTEGER :: je 418 450 INTEGER :: iadd 451 INTEGER :: iadd_exp 419 452 INTEGER :: iext 420 453 INTEGER :: indx_std 421 454 INTEGER :: iadd_std 422 455 INTEGER :: iadd_clm 456 457 458 ! 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 462 423 463 IF ( PRESENT( padd ) ) THEN 424 464 iadd = padd%inum … … 444 484 ENDIF 445 485 486 iadd_clm = 0 487 446 488 CALL init_obfbdata( fbdata ) 447 489 448 490 SELECT CASE ( TRIM(surfdata%cvars(1)) ) 449 491 CASE('SLA') 450 492 451 493 ! SLA needs special treatment because of MDT, so is all done here 452 494 ! Other variables are done more generically 495 ! No climatology for SLA, MDT is our best estimate of that and is already output. 453 496 454 497 CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & … … 485 528 clunits = 'Degree centigrade' 486 529 clgrid = 'T' 487 530 IF ( ln_output_clim ) iadd_clm = 1 531 488 532 CASE('ICECONC') 489 533 … … 499 543 clunits = 'psu' 500 544 clgrid = 'T' 501 545 IF ( ln_output_clim ) iadd_clm = 1 546 502 547 CASE('SLCHLTOT','LOGCHL','LogChl','logchl') 503 548 … … 610 655 611 656 CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 612 & 1 + iadd + iadd_std , iext, .TRUE. )657 & 1 + iadd + iadd_std + iadd_clm, iext, .TRUE. ) 613 658 614 659 fbdata%cname(1) = surfdata%cvars(1) … … 628 673 fbdata%cgrid(1) = clgrid 629 674 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)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) 633 678 END DO 634 679 … … 642 687 fbdata%caddunit(1+iadd_std,1) = fbdata%cobunit(1) 643 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) 694 ENDIF 695 644 696 645 697 WRITE(clfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(clfiletype), nproc … … 690 742 & krefdate = 19500101 ) 691 743 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) 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 693 751 fbdata%pob(1,jo,1) = surfdata%robs(jo,1) 694 752 fbdata%pdep(1,jo) = 0.0
Note: See TracChangeset
for help on using the changeset viewer.