New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 11468 for branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90 – NEMO

Ignore:
Timestamp:
2019-08-23T10:37:22+02:00 (5 years ago)
Author:
mattmartin
Message:

Merged changes to allow writing of climatological information to feedback files.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90

    r9306 r11468  
    6262   SUBROUTINE obs_prof_opt( prodatqc, kt, kpi, kpj, kpk, & 
    6363      &                     kit000, kdaystp, kvar,       & 
    64       &                     pvar, pgdept, pgdepw,        & 
    65       &                     pmask,                       &   
     64      &                     pvar, pclim,                 & 
     65      &                     pgdept, pgdepw, pmask,       &   
    6666      &                     plam, pphi,                  & 
    6767      &                     k1dint, k2dint, kdailyavtypes ) 
     
    137137      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: & 
    138138         & pvar,   &                 ! Model field for variable 
     139         & pclim,  &                 ! Climatology field for variable          
    139140         & pmask                     ! Land-sea mask for variable 
    140141      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 
     
    172173      REAL(KIND=wp), DIMENSION(kpk) :: & 
    173174         & zobsk,    & 
    174          & zobs2k 
     175         & zobs2k,   & 
     176         & zclm2k          
    175177      REAL(KIND=wp), DIMENSION(2,2,1) :: & 
    176178         & zweig1, & 
     
    178180      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: & 
    179181         & zmask,  & 
     182         & zclim,  &          
    180183         & zint,   & 
    181184         & zinm,   & 
     
    187190      REAL(KIND=wp), DIMENSION(1) :: zmsk 
    188191      REAL(KIND=wp), DIMENSION(:,:,:), ALLOCATABLE :: interp_corner 
    189  
     192      REAL(KIND=wp), DIMENSION(:,:,:), ALLOCATABLE :: interp_corner_clim 
     193       
    190194      LOGICAL :: ld_dailyav 
    191195 
     
    262266         & ) 
    263267 
     268      IF ( prodatqc%lclim ) ALLOCATE( zclim(2,2,kpk,ipro) ) 
     269 
    264270      DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro 
    265271         iobs = jobs - prodatqc%nprofup 
     
    286292      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, pgdepw, zgdepw )  
    287293 
     294      IF ( prodatqc%lclim ) THEN 
     295         CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, pclim, zclim )             
     296      ENDIF  
     297       
    288298      ! At the end of the day also get interpolated means 
    289299      IF ( ld_dailyav .AND. idayend == 0 ) THEN 
     
    349359                  inum_obs = iend - ista + 1  
    350360                  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                   
    352363                  DO iin=1,2  
    353364                     DO ijn=1,2  
     
    358369                              &     zobs2k, zgdept(iin,ijn,:,iobs), &  
    359370                              &     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 
    360379                        ENDIF  
    361380        
     
    371390                           &    zgdept(iin,ijn,:,iobs), &  
    372391                           &    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                         
    374402                     ENDDO  
    375403                  ENDDO  
     
    386414               inum_obs = iend - ista + 1  
    387415               ALLOCATE(interp_corner(2,2,inum_obs), iv_indic(inum_obs))  
     416               IF ( prodatqc%lclim ) ALLOCATE( interp_corner_clim(2,2,inum_obs) )                   
    388417               DO iin=1,2   
    389418                  DO ijn=1,2  
     
    394423                           &    zobs2k, zgdept(iin,ijn,:,iobs), &  
    395424                           &    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 
    396432   
    397433                     ENDIF  
     
    408444                         &          zgdept(iin,ijn,:,iobs),         &  
    409445                         &          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    
    410455          
    411456                  ENDDO  
     
    451496                  &              prodatqc%var(kvar)%vmod(iend:iend) )  
    452497 
     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 
    453503                  ! Set QC flag for any observations found below the bottom 
    454504                  ! needed as the check here is more strict than that in obs_prep 
     
    458508  
    459509            DEALLOCATE(interp_corner,iv_indic)  
    460            
     510            IF ( prodatqc%lclim ) DEALLOCATE( interp_corner_clim )          
     511              
    461512         ENDIF 
    462513 
     
    475526         & ) 
    476527 
     528      IF ( prodatqc%lclim ) DEALLOCATE( zclim ) 
     529       
    477530      ! At the end of the day also get interpolated means 
    478531      IF ( ld_dailyav .AND. idayend == 0 ) THEN 
     
    487540 
    488541   SUBROUTINE obs_surf_opt( surfdataqc, kt, kpi, kpj,            & 
    489       &                     kit000, kdaystp, psurf, psurfmask,   & 
     542      &                     kit000, kdaystp, psurf, pclim, psurfmask,   & 
    490543      &                     k2dint, ldnightav, plamscl, pphiscl, & 
    491544      &                     lindegrees ) 
     
    541594      REAL(wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 
    542595         & psurf,  &                   ! Model surface field 
     596         & pclim,  &                   ! Climatological surface field          
    543597         & psurfmask                   ! Land-sea mask 
    544598      LOGICAL, INTENT(IN) :: ldnightav ! Logical for averaging night-time data 
     
    569623      REAL(wp) :: zlam 
    570624      REAL(wp) :: zphi 
    571       REAL(wp), DIMENSION(1) :: zext, zobsmask 
     625      REAL(wp), DIMENSION(1) :: zext, zobsmask, zclm 
    572626      REAL(wp) :: zdaystp 
    573627      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 
     
    577631         & zsurfm, & 
    578632         & zsurftmp, & 
     633         & zclim,  & 
    579634         & zglam,  & 
    580635         & zgphi,  & 
     
    586641         & zouttmp, & 
    587642         & zmeanday    ! to compute model sst in region of 24h daylight (pole) 
    588  
     643          
    589644      !------------------------------------------------------------------------ 
    590645      ! Local initialization  
     
    679734         & ) 
    680735 
     736      IF ( surfdataqc%lclim ) ALLOCATE( zclim(imaxifp,imaxjfp,isurf) ) 
     737 
    681738      DO jobs = surfdataqc%nsurfup + 1, surfdataqc%nsurfup + isurf 
    682739         iobs = jobs - surfdataqc%nsurfup 
     
    715772      CALL obs_int_comm_2d( imaxifp, imaxjfp, isurf, kpi, kpj, & 
    716773         &                  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 
    721786 
    722787      ! At the end of the day get interpolated means 
     
    775840            CALL obs_int_h2d( 1, 1, zweig, zsurftmp(:,:,iobs), zext ) 
    776841 
     842            IF ( surfdataqc%lclim ) THEN   
     843               CALL obs_int_h2d( 1, 1, zweig, zclim(:,:,iobs), zclm ) 
     844            ENDIF 
     845 
     846 
    777847         ELSE 
    778848 
     
    788858               &              zweig, zsurftmp(:,:,iobs),  zext ) 
    789859 
     860            IF ( surfdataqc%lclim ) THEN   
     861               CALL obs_avg_h2d( 1, 1, imaxifp, imaxjfp, & 
     862                  &              zweig, zclim(:,:,iobs),  zclm ) 
     863            ENDIF 
     864 
    790865         ENDIF 
    791866 
     
    797872            surfdataqc%rmod(jobs,1) = zext(1) 
    798873         ENDIF 
     874          
     875         IF ( surfdataqc%lclim ) surfdataqc%rclm(jobs,1) = zclm(1) 
    799876          
    800877         IF ( zext(1) == obfillflt ) THEN 
     
    821898         & ) 
    822899 
     900      IF ( surfdataqc%lclim ) DEALLOCATE( zclim ) 
     901 
    823902      ! At the end of the day also deallocate night-time mean array 
    824903      IF ( idayend == 0 .AND. ldnightav ) THEN 
Note: See TracChangeset for help on using the changeset viewer.