swuvo3.F90

Go to the documentation of this file.

SUBROUTINE swuvo3 &
 & ( kidia,kfdia,klon,knu,kabs,&
 & pu, ptr &
 & )  
  
!**** *SWUVO3* - COMPUTES THE SHORTWAVE TRANSMISSION FUNCTIONS

!     PURPOSE.
!     --------
!           THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR OZONE
!     IN THE UV and VISIBLE SPECTRAL INTERVALS.

!**   INTERFACE.
!     ----------
!          *SWUVO3* IS CALLED FROM *SW1S*.

!        EXPLICIT ARGUMENTS :
!        --------------------
! KNU    :                     ; INDEX OF THE SPECTRAL INTERVAL
! KABS   :                     ; NUMBER OF ABSORBERS
! PU     : (KLON,KABS)         ; ABSORBER AMOUNT
!     ==== OUTPUTS ===
! PTR    : (KLON,KABS)         ; TRANSMISSION FUNCTION

!        IMPLICIT ARGUMENTS :   NONE
!        --------------------

!     METHOD.
!     -------

!          TRANSMISSION FUNCTION ARE COMPUTED USING SUMS OF EXPONENTIALS

!     EXTERNALS.
!     ----------

!          NONE

!     REFERENCE.
!     ----------
!        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
!        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS

!     AUTHOR.
!     -------
!        JEAN-JACQUES MORCRETTE  *ECMWF*

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 00-12-18
!        Modified J. HAGUE          03-01-03 MASS Vector Functions       
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
   
!-----------------------------------------------------------------------

USE parkind1  ,ONLY : jpim     ,jprb
USE yomhook   ,ONLY : lhook,   dr_hook

USE yoesw    , ONLY : nexpo3, rexpo3
USE yomjfh   , ONLY : n_vmass
USE write_field_phy

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KLON 
INTEGER(KIND=JPIM),INTENT(IN)    :: KABS 
INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNU 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PU(klon,kabs) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTR(klon,kabs) 
!-----------------------------------------------------------------------

!*       0.1   ARGUMENTS
!              ---------

!-----------------------------------------------------------------------

!              ------------

REAL(KIND=JPRB) :: ZU(klon)
REAL(KIND=JPRB) :: ZTMP1(kfdia-kidia+1+n_vmass)
REAL(KIND=JPRB) :: ZTMP2(kfdia-kidia+1+n_vmass)

INTEGER(KIND=JPIM) ::  JA, JL, IEXP, JX, JLEN
REAL(KIND=JPRB) :: ZHOOK_HANDLE
LOGICAL LLDEBUG

IF (lhook) CALL dr_hook('SWUVO3',0,zhook_handle)
iexp=nexpo3(knu)
lldebug=.false.

!print *,'Dans SWUVO3, N_VMASS= ',N_VMASS
IF(n_vmass > 0) THEN
  jlen=kfdia-kidia+n_vmass-mod(kfdia-kidia,n_vmass)
  IF(kfdia-kidia+1 /= jlen) THEN
    ztmp1(kfdia-kidia+2:jlen) = 0.0_jprb
  ENDIF
ENDIF

DO ja = 1,kabs
  DO jl=kidia,kfdia
    ptr(jl,ja)=0.0_jprb
  ENDDO
  
! Ce qui concerne N_VMASS commente par MPL 20.11.08
! IF(N_VMASS <= 0) THEN ! Do not use Vector Mass

!       WRITE(*,'("---> Dans SWUVO3 ")')
    DO jx=1,iexp
      DO jl = kidia,kfdia
        zu(jl) = pu(jl,ja)
        ptr(jl,ja) = ptr(jl,ja)+rexpo3(knu,1,jx)*exp(-rexpo3(knu,2,jx)*zu(jl))
!       WRITE(*,'("                 PTR ",E12.5)') (PTR(JL,JA))
!       WRITE(*,'("REXPO3-1 ",E12.5)') (REXPO3(KNU,1,JX))
!       WRITE(*,'("REXPO3-2 ",E12.5)') (REXPO3(KNU,2,JX))
!       WRITE(*,'("ZU ",E12.5)') (ZU(JL))
!       WRITE(*,'("KNU KABS IEXP ",3I6)') KNU,KABS,IEXP
      ENDDO
    ENDDO


! ELSE  ! Use Vector MASS

!   DO JX=1,IEXP
!     DO JL = KIDIA,KFDIA
!       ZTMP1(JL-KIDIA+1)=-REXPO3(KNU,2,JX)*PU(JL,JA)
!     ENDDO
  
!     CALL VEXP(ZTMP2,ZTMP1,JLEN)
  
!     DO JL = KIDIA,KFDIA
!       PTR(JL,JA) = PTR(JL,JA)+REXPO3(KNU,1,JX)*ZTMP2(JL-KIDIA+1)
!     ENDDO
!   ENDDO    

! ENDIF

ENDDO

IF(lldebug) THEN
    call writefield_phy("swuvo3_pu",pu,kabs)
    call writefield_phy("swuvo3_ptr",ptr,kabs)
ENDIF

IF (lhook) CALL dr_hook('SWUVO3',1,zhook_handle)
END SUBROUTINE swuvo3