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 3586 for branches/2012/dev_MERCATOR_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90 – NEMO

Ignore:
Timestamp:
2012-11-16T18:42:50+01:00 (11 years ago)
Author:
cbricaud
Message:

add modification from dev_r3342_MERCATOR7_SST in dev_MERCATOR_2012_rev3555

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2012/dev_MERCATOR_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90

    r2715 r3586  
    614614   END SUBROUTINE obs_sla_opt 
    615615 
    616    SUBROUTINE obs_sst_opt( sstdatqc, kt, kpi, kpj, kit000, & 
    617       &                    psstn, psstmask, k2dint ) 
    618  
     616   SUBROUTINE obs_sst_opt( sstdatqc, kt, kpi, kpj, kit000, kdaystp, & 
     617      &                    psstn, psstmask, k2dint, ld_nightav ) 
    619618      !!----------------------------------------------------------------------- 
    620619      !! 
     
    647646      !! * Modules used 
    648647      USE obs_surf_def  ! Definition of storage space for surface observations 
     648      USE sbcdcy 
    649649 
    650650      IMPLICIT NONE 
     
    659659                                       !   (kit000-1 = restart time) 
    660660      INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header) 
     661      INTEGER, INTENT(IN) :: kdaystp   ! Number of time steps per day   
    661662      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 
    662663         & psstn,  &    ! Model SST field 
    663664         & psstmask     ! Land-sea mask 
    664           
     665 
    665666      !! * Local declarations 
    666667      INTEGER :: ji 
     
    670671      INTEGER :: isst 
    671672      INTEGER :: iobs 
     673      INTEGER :: idayend 
    672674      REAL(KIND=wp) :: zlam 
    673675      REAL(KIND=wp) :: zphi 
    674676      REAL(KIND=wp) :: zext(1), zobsmask(1) 
     677      REAL(KIND=wp) :: zdaystp 
     678      INTEGER, DIMENSION(:,:), SAVE, ALLOCATABLE :: & 
     679         & icount_sstnight,      & 
     680         & imask_night 
     681      REAL(kind=wp), DIMENSION(:,:), SAVE, ALLOCATABLE :: & 
     682         & zintmp, & 
     683         & zouttmp, &  
     684         & zmeanday    ! to compute model sst in region of 24h daylight (pole) 
    675685      REAL(kind=wp), DIMENSION(2,2,1) :: & 
    676686         & zweig 
     
    678688         & zmask, & 
    679689         & zsstl, & 
     690         & zsstm, & 
    680691         & zglam, & 
    681692         & zgphi 
     
    683694         & igrdi, & 
    684695         & igrdj 
     696      LOGICAL, INTENT(IN) :: ld_nightav 
    685697 
    686698      !----------------------------------------------------------------------- 
     
    690702      inrc = kt - kit000 + 2 
    691703      isst = sstdatqc%nsstp(inrc) 
     704 
     705      IF ( ld_nightav ) THEN 
     706 
     707      ! Initialize array for night mean 
     708 
     709      IF ( kt .EQ. 0 ) THEN 
     710         ALLOCATE ( icount_sstnight(kpi,kpj) ) 
     711         ALLOCATE ( imask_night(kpi,kpj) ) 
     712         ALLOCATE ( zintmp(kpi,kpj) ) 
     713         ALLOCATE ( zouttmp(kpi,kpj) ) 
     714         ALLOCATE ( zmeanday(kpi,kpj) ) 
     715         nday_qsr = -1   ! initialisation flag for nbc_dcy 
     716      ENDIF 
     717 
     718      ! Initialize daily mean for first timestep 
     719      idayend = MOD( kt - kit000 + 1, kdaystp ) 
     720 
     721      ! Added kt == 0 test to catch restart case  
     722      IF ( idayend == 1 .OR. kt == 0) THEN 
     723         IF (lwp) WRITE(numout,*) 'Reset sstdatqc%vdmean on time-step: ',kt 
     724         DO jj = 1, jpj 
     725            DO ji = 1, jpi 
     726               sstdatqc%vdmean(ji,jj) = 0.0 
     727               zmeanday(ji,jj) = 0.0 
     728               icount_sstnight(ji,jj) = 0 
     729            END DO 
     730         END DO 
     731      ENDIF 
     732 
     733      zintmp(:,:) = 0.0 
     734      zouttmp(:,:) = sbc_dcy( zintmp(:,:), .TRUE. ) 
     735      imask_night(:,:) = INT( zouttmp(:,:) ) 
     736 
     737      DO jj = 1, jpj 
     738         DO ji = 1, jpi 
     739            ! Increment the temperature field for computing night mean and counter 
     740            sstdatqc%vdmean(ji,jj) = sstdatqc%vdmean(ji,jj)  & 
     741                   &                        + psstn(ji,jj)*imask_night(ji,jj) 
     742            zmeanday(ji,jj)        = zmeanday(ji,jj) + psstn(ji,jj) 
     743            icount_sstnight(ji,jj) = icount_sstnight(ji,jj) + imask_night(ji,jj) 
     744         END DO 
     745      END DO 
     746    
     747      ! Compute the daily mean at the end of day 
     748 
     749      zdaystp = 1.0 / REAL( kdaystp ) 
     750 
     751      IF ( idayend == 0 ) THEN  
     752         DO jj = 1, jpj 
     753            DO ji = 1, jpi 
     754               ! Test if "no night" point 
     755               IF ( icount_sstnight(ji,jj) .NE. 0 ) THEN 
     756                  sstdatqc%vdmean(ji,jj) = sstdatqc%vdmean(ji,jj) & 
     757                    &                        / icount_sstnight(ji,jj)  
     758               ELSE 
     759                  sstdatqc%vdmean(ji,jj) = zmeanday(ji,jj) * zdaystp 
     760               ENDIF 
     761            END DO 
     762         END DO 
     763      ENDIF 
     764 
     765      ENDIF 
    692766 
    693767      ! Get the data for interpolation 
     
    722796      CALL obs_int_comm_2d( 2, 2, isst, & 
    723797         &                  igrdi, igrdj, psstn, zsstl ) 
    724        
     798 
     799      ! At the end of the day get interpolated means 
     800      IF ( idayend == 0 .AND. ld_nightav ) THEN 
     801 
     802         ALLOCATE( & 
     803            & zsstm(2,2,isst)  & 
     804            & ) 
     805 
     806         CALL obs_int_comm_2d( 2, 2, isst, igrdi, igrdj, & 
     807            &               sstdatqc%vdmean(:,:), zsstm ) 
     808 
     809      ENDIF 
     810 
    725811      ! Loop over observations 
    726812 
     
    756842             
    757843         ! Interpolate the model SST to the observation point  
    758          CALL obs_int_h2d( 1, 1,      & 
     844 
     845         IF ( ld_nightav ) THEN 
     846 
     847           IF ( idayend == 0 )  THEN 
     848               ! Daily averaged/diurnal cycle of SST  data 
     849               CALL obs_int_h2d( 1, 1,      &  
     850                     &              zweig, zsstm(:,:,iobs), zext ) 
     851            ELSE  
     852               CALL ctl_stop( ' ld_nightav is set to true: a nonzero' //     & 
     853                     &           ' number of night SST data should' // & 
     854                     &           ' only occur at the end of a given day' ) 
     855            ENDIF 
     856 
     857         ELSE 
     858 
     859            CALL obs_int_h2d( 1, 1,      & 
    759860            &              zweig, zsstl(:,:,iobs),  zext ) 
     861 
     862         ENDIF 
    760863          
    761864         sstdatqc%rmod(jobs,1) = zext(1) 
     
    772875         & zsstl  & 
    773876         & ) 
     877 
     878      ! At the end of the day also get interpolated means 
     879      IF ( idayend == 0 .AND. ld_nightav ) THEN 
     880         DEALLOCATE( & 
     881            & zsstm  & 
     882            & ) 
     883      ENDIF 
    774884       
    775885      sstdatqc%nsurfup = sstdatqc%nsurfup + isst 
Note: See TracChangeset for help on using the changeset viewer.