coupling_tebn.F90

! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
 CALL DIAG_INLINE_TEB_n(TD%O, TD%D, SB, NT%AL(1), TOP%LCANOPY, &
                        PTA, PTRAD, ZQA, PPA, PPS, PRHOA, PU, PV, ZWIND, PZREF, PUREF, &
                        ZAVG_CD, ZAVG_CDN, ZAVG_RI, ZAVG_CH, ZAVG_Z0, PTRAD, PEMIS,    &
                        PDIR_ALB, PSCA_ALB, PLW, ZDIR_SWB, ZSCA_SWB,  PSFTH, PSFTQ,    &
                        PSFU, PSFV, PSFCO2, ZAVG_RN, ZAVG_H, ZAVG_LE, ZAVG_GFLX       )
!
!-------------------------------------------------------------------------------------
! Stores Canyon air and humidity if historical option of TEB is active
!-------------------------------------------------------------------------------------
!
IF (.NOT. TOP%LCANOPY) THEN
  DO JP=1,TOP%NTEB_PATCH
    NT%AL(JP)%XT_CANYON(:) = ZAVG_T_CANYON(:)
    NT%AL(JP)%XQ_CANYON(:) = ZAVG_Q_CANYON(:)
  END DO
END IF
!          
!-------------------------------------------------------------------------------------
! Thermal confort index
!-------------------------------------------------------------------------------------
!
IF (TD%DUT%LUTCI .AND. TD%O%N2M >0) THEN
  DO JJ=1,KI
    IF (TD%D%XZON10M(JJ)/=XUNDEF) THEN
      ZU_UTCI(JJ) = SQRT(TD%D%XZON10M(JJ)**2+TD%D%XMER10M(JJ)**2)
    ELSE
      ZU_UTCI(JJ) = ZWIND(JJ)
    ENDIF
  ENDDO
 CALL UTCI_TEB(NT%AL(1), TD%DUT, ZAVG_TI_BLD, ZAVG_QI_BLD, ZU_UTCI, PPS, ZAVG_REF_SW_GRND, &
               ZAVG_REF_SW_FAC, ZAVG_SCA_SW, ZAVG_DIR_SW, PZENITH, ZAVG_EMIT_LW_FAC,  &
               ZAVG_EMIT_LW_GRND, PLW, ZAVG_T_RAD_IND    )
 CALL UTCIC_STRESS(PTSTEP,TD%DUT%XUTCI_IN      ,TD%DUT%XUTCIC_IN      )
 CALL UTCIC_STRESS(PTSTEP,TD%DUT%XUTCI_OUTSUN  ,TD%DUT%XUTCIC_OUTSUN  )
 CALL UTCIC_STRESS(PTSTEP,TD%DUT%XUTCI_OUTSHADE,TD%DUT%XUTCIC_OUTSHADE)
ELSE IF (TD%DUT%LUTCI) THEN
  TD%DUT%XUTCI_IN         (:) = XUNDEF
  TD%DUT%XUTCI_OUTSUN     (:) = XUNDEF
  TD%DUT%XUTCI_OUTSHADE   (:) = XUNDEF
  TD%DUT%XTRAD_SUN        (:) = XUNDEF
  TD%DUT%XTRAD_SHADE      (:) = XUNDEF
  TD%DUT%XUTCIC_IN      (:,:) = XUNDEF
  TD%DUT%XUTCIC_OUTSUN  (:,:) = XUNDEF
  TD%DUT%XUTCIC_OUTSHADE(:,:) = XUNDEF
ENDIF

!
IF (LHOOK) CALL DR_HOOK('COUPLING_TEB_N',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------------
CONTAINS
SUBROUTINE ADD_PATCH_CONTRIB(JP,PAVG,PFIELD)
INTEGER, INTENT(IN) :: JP
REAL, DIMENSION(:), INTENT(INOUT) :: PAVG
REAL, DIMENSION(:), INTENT(IN)    :: PFIELD
!
IF (JP==1) PAVG = 0.
PAVG = PAVG + TOP%XTEB_PATCH(:,JP) * PFIELD(:)
!
END SUBROUTINE ADD_PATCH_CONTRIB
!-------------------------------------------------------------------------------------
!
END SUBROUTINE COUPLING_TEB_n