Changeset 11455


Ignore:
Timestamp:
2019-08-19T17:36:23+02:00 (14 months ago)
Author:
mattmartin
Message:

Commit version which compiles and runs. Not fully tested that it is producing the correct answer yet though.

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  
    12321232   ln_s_at_t  = .false.             ! Logical switch for computing model S at T obs if not there 
    12331233   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 
    12341235   ln_default_fp_indegs = .true.    ! Logical: T=> averaging footprint is in degrees, F=> in metres 
    12351236   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  
    5050   LOGICAL :: ln_diaobs            !: Logical switch for the obs operator 
    5151   LOGICAL :: ln_sstnight          !: Logical switch for night mean SST obs 
    52    LOGICAL :: ln_output_clim       !: Logical switch for interpolating and outputting T/S climatology 
    5352   LOGICAL :: ln_default_fp_indegs !: T=> Default obs footprint size specified in degrees, F=> in metres 
    5453   LOGICAL :: ln_sla_fp_indegs     !: T=>     SLA obs footprint size specified in degrees, F=> in metres 
     
    5655   LOGICAL :: ln_sss_fp_indegs     !: T=>     SSS obs footprint size specified in degrees, F=> in metres 
    5756   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 
    5858 
    5959   REAL(wp) :: rn_default_avglamscl !: Default E/W diameter of observation footprint 
     
    235235      LOGICAL :: ltype_fp_indegs ! Local version of ln_*_fp_indegs 
    236236      LOGICAL :: ltype_night     ! Local version of ln_sstnight (false for other variables) 
     237      LOGICAL :: ltype_clim      ! Local version of ln_output_clim 
    237238 
    238239      REAL(wp), POINTER, DIMENSION(:,:,:) :: & 
     
    728729 
    729730         DO jtype = 1, nproftypes 
    730  
     731             
     732            ltype_clim = .FALSE.  
     733             
    731734            IF ( TRIM(cobstypesprof(jtype)) == 'prof' ) THEN 
    732735               nvarsprof(jtype) = 2 
    733736               nextrprof(jtype) = 1 
     737               IF ( ln_output_clim ) ltype_clim = .TRUE.               
    734738               ALLOCATE(llvar(nvarsprof(jtype))) 
    735739               CALL wrk_alloc( jpi, jpj,      nvarsprof(jtype), zglam ) 
     
    777781               &               nvarsprof(jtype), nextrprof(jtype), nitend-nit000+2, & 
    778782               &               rn_dobsini, rn_dobsend, llvar, & 
    779                &               ln_ignmis, ln_s_at_t, .FALSE., & 
     783               &               ln_ignmis, ln_s_at_t, .FALSE., ltype_clim, & 
    780784               &               kdailyavtypes = nn_profdavtypes ) 
    781785 
     
    813817            nvarssurf(jtype) = 1 
    814818            nextrsurf(jtype) = 0 
     819            ltype_clim = .FALSE. 
    815820            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. 
    816825 
    817826            !Read in surface obs types 
     
    819828               &               clsurffiles(jtype,1:ifilessurf(jtype)), & 
    820829               &               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 ) 
    822832 
    823833            CALL obs_pre_surf( surfdata(jtype), surfdataqc(jtype), ln_nea, ln_bound_reject ) 
     
    928938         & jp_spm 
    929939#endif 
     940      USE tradmp, ONLY: & 
     941         & tclim, & 
     942         & sclim 
    930943 
    931944      IMPLICIT NONE 
     
    956969         & pco2_3d                 ! 3D pCO2 from FABM 
    957970#endif 
    958       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  zts_dta  
    959971       
    960972      IF(lwp) THEN 
     
    966978 
    967979      idaystp = NINT( rday / rdt ) 
    968  
    969       ! Get the climatological T & S fields on this time step 
    970       IF ( ln_output_clim ) CALL dta_tsd( kstp, zts_dta ) 
    971980 
    972981      !----------------------------------------------------------------------- 
     
    9981007               zprofvar(:,:,:,1) = tsn(:,:,:,jp_tem) 
    9991008               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(:,:,:) 
    10031012               ENDIF 
    10041013                
     
    12191228            CASE('sst') 
    12201229               zsurfvar(:,:) = tsn(:,:,1,jp_tem) 
    1221                IF ( ln_output_clim ) zsurfclim(:,:) = zts_dta(:,:,1,jp_tem) 
     1230               IF ( ln_output_clim ) zsurfclim(:,:) = tclim(:,:,1) 
    12221231            CASE('sla') 
    12231232               zsurfvar(:,:)  = sshn(:,:) 
    12241233            CASE('sss') 
    12251234               zsurfvar(:,:) = tsn(:,:,1,jp_sal) 
    1226                IF ( ln_output_clim ) zsurfclim(:,:) = zts_dta(:,:,1,jp_sal)                
     1235               IF ( ln_output_clim ) zsurfclim(:,:) = sclim(:,:,1)               
    12271236            CASE('sic') 
    12281237               IF ( kstp == 0 ) THEN 
  • branches/UKMO/dev_r5518_obs_oper_update_addclim/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90

    r11449 r11455  
    190190      REAL(KIND=wp), DIMENSION(1) :: zmsk 
    191191      REAL(KIND=wp), DIMENSION(:,:,:), ALLOCATABLE :: interp_corner 
    192  
     192      REAL(KIND=wp), DIMENSION(:,:,:), ALLOCATABLE :: interp_corner_clim 
     193       
    193194      LOGICAL :: ld_dailyav 
    194       LOGICAL :: ld_clim 
    195195 
    196196      !------------------------------------------------------------------------ 
     
    200200      inrc = kt - kit000 + 2 
    201201      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 
    209202 
    210203      ! Daily average types 
     
    273266         & ) 
    274267 
    275       IF ( ld_clim ) ALLOCATE( zclim(2,2,kpk,ipro) ) 
     268      IF ( prodatqc%lclim ) ALLOCATE( zclim(2,2,kpk,ipro) ) 
    276269 
    277270      DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro 
     
    299292      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, pgdepw, zgdepw )  
    300293 
    301       IF ( ld_clim ) THEN 
     294      IF ( prodatqc%lclim ) THEN 
    302295         CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, pclim, zclim )             
    303296      ENDIF  
     
    366359                  inum_obs = iend - ista + 1  
    367360                  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) ) 
    369362                   
    370363                  DO iin=1,2  
     
    377370                              &     zmask(iin,ijn,:,iobs))  
    378371 
    379                            IF ( ld_clim ) THEN 
     372                           IF ( prodatqc%lclim ) THEN 
    380373                              CALL obs_int_z1d_spl( kpk, &  
    381374                                 &     zclim(iin,ijn,:,iobs), &  
     
    398391                           &    zmask(iin,ijn,:,iobs))  
    399392 
    400                         IF ( ld_clim ) THEN 
     393                        IF ( prodatqc%lclim ) THEN 
    401394                           CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs, &  
    402395                              &    prodatqc%var(kvar)%vdep(ista:iend), &  
     
    422415               ALLOCATE( interp_corner(2,2,inum_obs),      & 
    423416                  &      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) )                   
    425418               DO iin=1,2   
    426419                  DO ijn=1,2  
     
    432425                           &    zmask(iin,ijn,:,iobs))  
    433426 
    434                         IF ( ld_clim ) THEN 
     427                        IF ( prodatqc%lclim ) THEN 
    435428                           CALL obs_int_z1d_spl( kpk, &  
    436429                              &    zclim(iin,ijn,:,iobs),&  
     
    453446                         &          zmask(iin,ijn,:,iobs) )       
    454447 
    455                      IF ( ld_clim ) THEN 
     448                     IF ( prodatqc%lclim ) THEN 
    456449                        CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs,     &  
    457450                            &          prodatqc%var(kvar)%vdep(ista:iend),     &  
     
    504497                  &              prodatqc%var(kvar)%vmod(iend:iend) )  
    505498 
    506                IF ( ld_clim ) THEN 
     499               IF ( prodatqc%lclim ) THEN 
    507500                  CALL obs_int_h2d( 1, 1, zweig, interp_corner_clim(:,:,ikn), &  
    508501                     &              prodatqc%var(kvar)%vclm(iend:iend) ) 
     
    516509  
    517510            DEALLOCATE(interp_corner,iv_indic)  
    518             IF ( ld_clim ) DEALLOCATE( interp_corner_clim )          
     511            IF ( prodatqc%lclim ) DEALLOCATE( interp_corner_clim )          
    519512              
    520513         ENDIF 
     
    534527         & ) 
    535528 
    536       IF ( ld_clim ) DEALLOCATE( zclim ) 
     529      IF ( prodatqc%lclim ) DEALLOCATE( zclim ) 
    537530       
    538531      ! At the end of the day also get interpolated means 
     
    650643         & zmeanday    ! to compute model sst in region of 24h daylight (pole) 
    651644          
    652       LOGICAL :: ld_clim ! T => climatological data is available 
    653645      !------------------------------------------------------------------------ 
    654646      ! Local initialization  
     
    657649      inrc = kt - kit000 + 2 
    658650      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 
    666651 
    667652      ! Work out the maximum footprint size for the  
     
    750735         & ) 
    751736 
    752       IF ( ld_clim ) ALLOCATE( zclim(imaxifp,imaxjfp,isurf) ) 
     737      IF ( surfdataqc%lclim ) ALLOCATE( zclim(imaxifp,imaxjfp,isurf) ) 
    753738 
    754739      DO jobs = surfdataqc%nsurfup + 1, surfdataqc%nsurfup + isurf 
     
    793778         &                  igrdip1, igrdjp1, gphif, zgphif ) 
    794779 
    795       IF ( ld_clim ) THEN  
     780      IF ( surfdataqc%lclim ) THEN  
    796781         CALL obs_int_comm_2d( imaxifp, imaxjfp, isurf, kpi, kpj, & 
    797782            &                  igrdi, igrdj, pclim, zclim ) 
     
    853838            CALL obs_int_h2d( 1, 1, zweig, zsurftmp(:,:,iobs), zext ) 
    854839 
    855             IF ( ld_clim ) THEN   
     840            IF ( surfdataqc%lclim ) THEN   
    856841               CALL obs_int_h2d( 1, 1, zweig, zclim(:,:,iobs), zclm ) 
     842               IF (lwp) THEN 
     843                  WRITE(numout,*)'zclim: ', iobs, zclim(:,:,iobs), zclm 
     844               ENDIF 
    857845            ENDIF 
    858846 
     
    871859               &              zweig, zsurftmp(:,:,iobs),  zext ) 
    872860 
    873             IF ( ld_clim ) THEN   
     861            IF ( surfdataqc%lclim ) THEN   
    874862               CALL obs_avg_h2d( 1, 1, imaxifp, imaxjfp, & 
    875863                  &              zweig, zsurftmp(:,:,iobs),  zclm ) 
     
    886874         ENDIF 
    887875          
    888          IF ( ld_clim ) surfdataqc%rclm(jobs,1) = zclm(1) 
     876         IF ( surfdataqc%lclim ) surfdataqc%rclm(jobs,1) = zclm(1) 
    889877          
    890878         IF ( zext(1) == obfillflt ) THEN 
     
    911899         & ) 
    912900 
    913       IF ( ld_clim ) DEALLOCATE( zclim ) 
     901      IF ( surfdataqc%lclim ) DEALLOCATE( zclim ) 
    914902 
    915903      ! 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  
    7373         & vobs,  &       !: Profile data 
    7474         & vmod,  &       !: Model counterpart of the profile data vector 
    75          & vclm,  &       !: Climatological counterpart of the profile data vector 
     75         & vclm           !: Climatological counterpart of the profile data vector 
    7676          
    7777      REAL(KIND=wp), POINTER, DIMENSION(:,:) :: & 
     
    103103      INTEGER :: nprofup  !: Observation counter used in obs_oper 
    104104 
     105      LOGICAL :: lclim    !: Climatology will be calculated for this structure 
     106       
    105107      ! Bookkeeping arrays with sizes equal to number of variables 
    106108 
     
    199201    
    200202   SUBROUTINE obs_prof_alloc( prof,  kvar, kext, kprof,  & 
    201       &                       ko3dt, kstp, kpi, kpj, kpk ) 
     203      &                       ko3dt, kstp, kpi, kpj, kpk, ldclim ) 
    202204      !!---------------------------------------------------------------------- 
    203205      !!                     ***  ROUTINE obs_prof_alloc  *** 
     
    222224      INTEGER, INTENT(IN) :: kpj 
    223225      INTEGER, INTENT(IN) :: kpk 
     226      LOGICAL, INTENT(IN) :: ldclim 
    224227 
    225228      !!* Local variables 
     
    237240      prof%npj       = kpj 
    238241      prof%npk       = kpk 
     242       
     243      prof%lclim     = ldclim 
    239244 
    240245      ! Allocate arrays of size number of variables 
     
    493498         & prof%var(kvar)%vobs(kobs),      & 
    494499         & prof%var(kvar)%vmod(kobs),      & 
    495          & prof%var(kvar)%vclm(kobs),      &          
    496500         & prof%var(kvar)%nvind(kobs)      & 
    497501         & ) 
     
    503507         ALLOCATE( &  
    504508            & prof%var(kvar)%vext(kobs,kext) & 
     509            & ) 
     510      ENDIF 
     511      IF (prof%lclim) THEN 
     512         ALLOCATE( &  
     513            & prof%var(kvar)%vclm(kobs) & 
    505514            & ) 
    506515      ENDIF 
     
    532541         & prof%var(kvar)%vobs,   & 
    533542         & prof%var(kvar)%vmod,   & 
    534          & prof%var(kvar)%vclm,   &          
    535543         & prof%var(kvar)%nvind,  & 
    536544         & prof%var(kvar)%idqcf,  & 
     
    540548         DEALLOCATE( &  
    541549            & prof%var(kvar)%vext  & 
     550            & ) 
     551      ENDIF 
     552      IF (prof%lclim) THEN 
     553         DEALLOCATE( &  
     554            & prof%var(kvar)%vclm  & 
    542555            & ) 
    543556      ENDIF 
     
    633646            &                 inprof,    invpro,    & 
    634647            &                 prof%nstp, prof%npi,  & 
    635             &                 prof%npj,  prof%npk ) 
     648            &                 prof%npj,  prof%npk,  & 
     649            &                 prof%lclim ) 
    636650      ENDIF 
    637651 
     
    744758                     newprof%var(jvar)%vmod(invpro(jvar))   = & 
    745759                        &                           prof%var(jvar)%vmod(jj) 
    746                      newprof%var(jvar)%vclm(invpro(jvar))   = & 
    747                         &                           prof%var(jvar)%vclm(jj) 
    748760                     DO jext = 1, prof%next 
    749761                        newprof%var(jvar)%vext(invpro(jvar),jext) = & 
    750762                           &                      prof%var(jvar)%vext(jj,jext) 
    751763                     END DO 
    752                    
     764                     IF (newprof%lclim) THEN 
     765                        newprof%var(jvar)%vclm(invpro(jvar))   = & 
     766                           &                           prof%var(jvar)%vclm(jj) 
     767                     ENDIF 
     768                                     
    753769                     ! nvind is the index of the original variable data 
    754770                      
     
    869885               oldprof%var(jvar)%vobs(jl)   = prof%var(jvar)%vobs(jj) 
    870886               oldprof%var(jvar)%vmod(jl)   = prof%var(jvar)%vmod(jj) 
    871                oldprof%var(jvar)%vclm(jl)   = prof%var(jvar)%vclm(jj)                
    872887               oldprof%var(jvar)%idqcf(:,jl) = prof%var(jvar)%idqcf(:,jj) 
    873888               oldprof%var(jvar)%nvqcf(:,jl) = prof%var(jvar)%nvqcf(:,jj) 
     
    876891                     &                        prof%var(jvar)%vext(jj,jext) 
    877892               END DO 
    878                 
     893               IF (prof%lclim) THEN 
     894                  oldprof%var(jvar)%vclm(jl)   = prof%var(jvar)%vclm(jj) 
     895               ENDIF               
    879896            END DO 
    880897 
  • branches/UKMO/dev_r5518_obs_oper_update_addclim/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90

    r9306 r11455  
    4646      &                     kvars, kextr, kstp, ddobsini, ddobsend, & 
    4747      &                     ldvar, ldignmis, ldsatt, & 
    48       &                     ldmod, kdailyavtypes ) 
     48      &                     ldmod, ldclim, kdailyavtypes ) 
    4949      !!--------------------------------------------------------------------- 
    5050      !! 
     
    7878      LOGICAL, INTENT(IN) :: ldsatt     ! Compute salinity at all temperature points 
    7979      LOGICAL, INTENT(IN) :: ldmod      ! Initialize model from input data 
     80      LOGICAL, INTENT(IN) :: ldclim     ! Set flag to show climatology will be output 
    8081      REAL(dp), INTENT(IN) :: ddobsini  ! Obs. ini time in YYYYMMDD.HHMMSS 
    8182      REAL(dp), INTENT(IN) :: ddobsend  ! Obs. end time in YYYYMMDD.HHMMSS 
     
    500501      ENDIF 
    501502      CALL obs_prof_alloc( profdata, kvars, kextr, iprof, iv3dt, & 
    502          &                 kstp, jpi, jpj, jpk ) 
     503         &                 kstp, jpi, jpj, jpk, ldclim ) 
    503504 
    504505      ! * 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  
    4040   SUBROUTINE obs_rea_surf( surfdata, knumfiles, cdfilenames, & 
    4141      &                     kvars, kextr, kstp, ddobsini, ddobsend, & 
    42       &                     ldignmis, ldmod, ldnightav ) 
     42      &                     ldignmis, ldmod, ldnightav, ldclim ) 
    4343      !!--------------------------------------------------------------------- 
    4444      !! 
     
    7171      LOGICAL, INTENT(IN) :: ldmod      ! Initialize model from input data 
    7272      LOGICAL, INTENT(IN) :: ldnightav  ! Observations represent a night-time average 
     73      LOGICAL, INTENT(IN) :: ldclim     ! Will include climatology at obs points. 
    7374      REAL(dp), INTENT(IN) :: ddobsini   ! Obs. ini time in YYYYMMDD.HHMMSS 
    7475      REAL(dp), INTENT(IN) :: ddobsend   ! Obs. end time in YYYYMMDD.HHMMSS 
     
    359360         &               iindx   ) 
    360361 
    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 ) 
    362363 
    363364      ! 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  
    5252      INTEGER :: nrec       !: Number of surface observation records in window 
    5353 
     54      LOGICAL :: lclim      !: Climatology will be calculated for this structure 
     55       
    5456      ! Arrays with size equal to the number of surface observations 
    5557 
     
    125127CONTAINS 
    126128    
    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 ) 
    128130      !!---------------------------------------------------------------------- 
    129131      !!                     ***  ROUTINE obs_surf_alloc  *** 
     
    144146      INTEGER, INTENT(IN) :: kpi     ! Number of 3D grid points 
    145147      INTEGER, INTENT(IN) :: kpj 
     148      LOGICAL, INTENT(IN) :: ldclim   
    146149 
    147150      !!* Local variables 
     
    158161      surf%npi      = kpi 
    159162      surf%npj      = kpj 
     163      surf%lclim    = ldclim 
    160164 
    161165      ! Allocate arrays of size number of variables 
     
    198202      ALLOCATE( &  
    199203         & surf%robs(ksurf,kvar), & 
    200          & surf%rmod(ksurf,kvar), & 
    201          & surf%rclm(ksurf,kvar)  &          
     204         & surf%rmod(ksurf,kvar) & 
    202205         & )    
    203206 
     207      IF (surf%lclim) ALLOCATE( surf%rclm(ksurf,kvar) ) 
     208       
    204209      ! Allocate arrays of number of extra fields at observation points 
    205210 
     
    292297      DEALLOCATE( &  
    293298         & surf%robs,    & 
    294          & surf%rmod,    & 
    295          & surf%rclm     &          
    296          & ) 
    297  
     299         & surf%rmod     & 
     300         & ) 
     301 
     302      IF (surf%lclim) DEALLOCATE( surf%rclm ) 
    298303      ! Deallocate arrays of number of extra fields at observation points 
    299304 
     
    374379      IF ( lallocate ) THEN 
    375380         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 ) 
    377382      ENDIF 
    378383 
     
    421426               newsurf%robs(insurf,jk)  = surf%robs(ji,jk) 
    422427               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)  
    424429                
    425430            END DO 
     
    518523            oldsurf%robs(jj,jk)  = surf%robs(ji,jk) 
    519524            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)             
    521526 
    522527         END DO 
  • branches/UKMO/dev_r5518_obs_oper_update_addclim/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90

    r11449 r11455  
    2929   USE obs_mpp              ! MPP support routines for observation diagnostics 
    3030   USE lib_mpp        ! MPP routines 
    31    USE diaobs, ONLY: & 
    32       & ln_output_clim 
    3331 
    3432   IMPLICIT NONE 
     
    9795      INTEGER :: je 
    9896      INTEGER :: iadd 
    99       INTEGER :: iadd_exp  ! expected additional variables 
     97      INTEGER :: iadd_clm ! 1 if climatology present 
    10098      INTEGER :: iext 
    10199      REAL(wp) :: zpres 
     
    104102      ! Set up number of additional variables to be ouput: 
    105103      ! Hx, CLIM, ... 
    106       iadd_exp = 1   ! Hx 
    107       IF ( ln_output_clim ) iadd_exp = iadd_exp + 1 
     104      iadd_clm = 0  
     105      IF ( profdata%lclim ) iadd_clm = 1 
    108106       
    109107      IF ( PRESENT( padd ) ) THEN 
     
    132130         clfiletype='profb' 
    133131         CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, & 
    134             &                 iadd_exp + iadd, 1 + iext, .TRUE. ) 
     132            &                 1 + iadd_clm + iadd, 1 + iext, .TRUE. ) 
    135133         fbdata%cname(1)      = profdata%cvars(1) 
    136134         fbdata%cname(2)      = profdata%cvars(2) 
     
    148146         fbdata%caddunit(1,1) = 'Degrees centigrade' 
    149147         fbdata%caddunit(1,2) = 'PSU' 
    150          IF ( ln_output_clim ) THEN 
     148         IF ( profdata%lclim ) THEN 
    151149            fbdata%caddlong(2,1) = 'Climatology interpolated potential temperature' 
    152150            fbdata%caddlong(2,2) = 'Climatology interpolated practical salinity' 
     
    161159         END DO 
    162160         DO ja = 1, iadd 
    163             fbdata%caddname(iadd_exp+ja) = padd%cdname(ja) 
     161            fbdata%caddname(1+iadd_clm+ja) = padd%cdname(ja) 
    164162            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) 
    167165            END DO 
    168166         END DO 
     
    172170         clfiletype='velfb' 
    173171         CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, & 
    174             &                 iadd_exp + iadd, 0, .TRUE. ) 
     172            &                 1 + iadd_clm + iadd, 0, .TRUE. ) 
    175173         fbdata%cname(1)      = profdata%cvars(1) 
    176174         fbdata%cname(2)      = profdata%cvars(2) 
     
    188186         fbdata%caddunit(1,1) = 'm/s' 
    189187         fbdata%caddunit(1,2) = 'm/s' 
    190          IF ( ln_output_clim ) THEN 
     188         IF ( profdata%lclim ) THEN 
    191189            fbdata%caddlong(2,1) = 'Climatology interpolated zonal velocity' 
    192190            fbdata%caddlong(2,2) = 'Climatology interpolated meridional velocity' 
     
    197195         fbdata%cgrid(2)      = 'V' 
    198196         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) 
    202200         END DO 
    203201 
     
    270268         & ( TRIM(profdata%cvars(1)) /= 'UVEL' ) ) THEN 
    271269         CALL alloc_obfbdata( fbdata, 1, profdata%nprof, ilevel, & 
    272             &                 iadd_expt + iadd, iext, .TRUE. ) 
     270            &                 1 + iadd_clm + iadd, iext, .TRUE. ) 
    273271         fbdata%cname(1)      = profdata%cvars(1) 
    274272         fbdata%coblong(1)    = cllongname 
     
    276274         fbdata%caddlong(1,1) = 'Model interpolated ' // TRIM(cllongname) 
    277275         fbdata%caddunit(1,1) = clunits 
    278          IF ( ln_output_clim ) THEN 
     276         IF ( profdata%lclim ) THEN 
    279277            fbdata%caddlong(2,1) = 'Climatological interpolated ' // TRIM(cllongname) 
    280278            fbdata%caddunit(2,1) = clunits 
     
    287285         END DO 
    288286         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) 
    292290         END DO 
    293291      ENDIF 
    294292 
    295293      fbdata%caddname(1)   = 'Hx' 
    296       IF ( ln_output_clim ) fbdata%caddname(2)   = 'CLM' 
     294      IF ( profdata%lclim ) fbdata%caddname(1+iadd_clm)   = 'CLM' 
    297295       
    298296      WRITE(clfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(clfiletype), nproc 
     
    348346            DO jk = profdata%npvsta(jo,jvar), profdata%npvend(jo,jvar) 
    349347               ik = profdata%var(jvar)%nvlidx(jk) 
    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               
    354348               fbdata%pob(ik,jo,jvar)    = profdata%var(jvar)%vobs(jk) 
    355349               fbdata%pdep(ik,jo)        = profdata%var(jvar)%vdep(jk) 
     
    365359               ENDIF 
    366360               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               
    367366               DO ja = 1, iadd 
    368                   fbdata%padd(ik,jo,iadd_exp+ja,jvar) = & 
     367                  fbdata%padd(ik,jo,1+iadd_clm+ja,jvar) = & 
    369368                     & profdata%var(jvar)%vext(jk,padd%ipoint(ja)) 
    370369               END DO 
     
    449448      INTEGER :: je 
    450449      INTEGER :: iadd 
    451       INTEGER :: iadd_exp 
    452450      INTEGER :: iext 
    453451      INTEGER :: indx_std 
    454452      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 
    456461 
    457462 
    458463      ! 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... 
    462465  
    463466      IF ( PRESENT( padd ) ) THEN 
     
    466469         iadd = 0 
    467470      ENDIF 
    468  
    469       IF ( PRESENT( pext ) ) THEN 
    470          iext = pext%inum 
    471       ELSE 
    472          iext = 0 
    473       ENDIF 
    474  
     471       
    475472      iadd_std = 0 
    476473      indx_std = -1 
     
    485482       
    486483      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 
    487488       
    488489      CALL init_obfbdata( fbdata ) 
     
    496497 
    497498         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. ) 
    499501 
    500502         clfiletype = 'slafb' 
     
    517519         fbdata%cgrid(1)      = 'T' 
    518520         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) 
    522524         END DO 
    523525 
     
    528530         clunits    = 'Degree centigrade' 
    529531         clgrid     = 'T' 
    530          IF ( ln_output_clim ) iadd_clm = 1 
    531532          
    532533      CASE('ICECONC') 
     
    543544         clunits    = 'psu' 
    544545         clgrid     = 'T' 
    545          IF ( ln_output_clim ) iadd_clm = 1 
    546546          
    547547      CASE('SLCHLTOT','LOGCHL','LogChl','logchl') 
     
    655655       
    656656         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. ) 
    658658 
    659659         fbdata%cname(1)      = surfdata%cvars(1) 
     
    673673         fbdata%cgrid(1)      = clgrid 
    674674         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) 
    678678         END DO 
    679679 
     
    682682      fbdata%caddname(1)   = 'Hx' 
    683683      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) 
    694693      ENDIF 
    695694       
     
    741740            &           fbdata%ptim(jo),   & 
    742741            &           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                     
    751743         fbdata%pob(1,jo,1)    = surfdata%robs(jo,1)  
    752744         fbdata%pdep(1,jo)     = 0.0 
     
    764756         ENDIF 
    765757         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 
    767767         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) 
    769769         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 
    770779          
    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)          
    775782         DO je = 1, iext 
    776783            fbdata%pext(1,jo,1+je) = & 
  • branches/UKMO/dev_r5518_obs_oper_update_addclim/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90

    r7960 r11455  
    5555   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ttrdmp   !: damping temperature trend (Celcius/s) 
    5656   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    
    5860   !! * Substitutions 
    5961#  include "domzgr_substitute.h90" 
     
    7072      !!                ***  FUNCTION tra_dmp_alloc  *** 
    7173      !!---------------------------------------------------------------------- 
    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 ) 
    7376      ! 
    7477      IF( lk_mpp            )   CALL mpp_sum ( tra_dmp_alloc ) 
     
    110113      !                           !==   input T-S data at kt   ==! 
    111114      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) 
    112118      ! 
    113119      SELECT CASE ( nn_zdmp )     !==    type of damping   ==! 
Note: See TracChangeset for help on using the changeset viewer.