source: LMDZ5/trunk/libf/phylmd/rrtm/swuvo3.F90 @ 4799

Last change on this file since 4799 was 1990, checked in by Laurent Fairhead, 11 years ago

Corrections à la version r1989 pour permettre la compilation avec RRTM
Inclusion de la licence CeCILL_V2 pour RRTM


Changes to revision r1989 to enable RRTM code compilation
RRTM part put under CeCILL_V2 licence

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 3.7 KB
Line 
1SUBROUTINE SWUVO3 &
2 & ( KIDIA,KFDIA,KLON,KNU,KABS,&
3 & PU, PTR &
4 & ) 
5 
6!**** *SWUVO3* - COMPUTES THE SHORTWAVE TRANSMISSION FUNCTIONS
7
8!     PURPOSE.
9!     --------
10!           THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR OZONE
11!     IN THE UV and VISIBLE SPECTRAL INTERVALS.
12
13!**   INTERFACE.
14!     ----------
15!          *SWUVO3* IS CALLED FROM *SW1S*.
16
17!        EXPLICIT ARGUMENTS :
18!        --------------------
19! KNU    :                     ; INDEX OF THE SPECTRAL INTERVAL
20! KABS   :                     ; NUMBER OF ABSORBERS
21! PU     : (KLON,KABS)         ; ABSORBER AMOUNT
22!     ==== OUTPUTS ===
23! PTR    : (KLON,KABS)         ; TRANSMISSION FUNCTION
24
25!        IMPLICIT ARGUMENTS :   NONE
26!        --------------------
27
28!     METHOD.
29!     -------
30
31!          TRANSMISSION FUNCTION ARE COMPUTED USING SUMS OF EXPONENTIALS
32
33!     EXTERNALS.
34!     ----------
35
36!          NONE
37
38!     REFERENCE.
39!     ----------
40!        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
41!        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
42
43!     AUTHOR.
44!     -------
45!        JEAN-JACQUES MORCRETTE  *ECMWF*
46
47!     MODIFICATIONS.
48!     --------------
49!        ORIGINAL : 00-12-18
50!        Modified J. HAGUE          03-01-03 MASS Vector Functions       
51!        M.Hamrud      01-Oct-2003 CY28 Cleaning
52   
53!-----------------------------------------------------------------------
54
55USE PARKIND1  ,ONLY : JPIM     ,JPRB
56USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
57
58USE YOESW    , ONLY : NEXPO3, REXPO3
59USE YOMJFH   , ONLY : N_VMASS
60USE write_field_phy
61
62IMPLICIT NONE
63
64INTEGER(KIND=JPIM),INTENT(IN)    :: KLON
65INTEGER(KIND=JPIM),INTENT(IN)    :: KABS
66INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
67INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
68INTEGER(KIND=JPIM),INTENT(IN)    :: KNU
69REAL(KIND=JPRB)   ,INTENT(IN)    :: PU(KLON,KABS)
70REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTR(KLON,KABS)
71!-----------------------------------------------------------------------
72
73!*       0.1   ARGUMENTS
74!              ---------
75
76!-----------------------------------------------------------------------
77
78!              ------------
79
80REAL(KIND=JPRB) :: ZU(KLON)
81REAL(KIND=JPRB) :: ZTMP1(KFDIA-KIDIA+1+N_VMASS)
82REAL(KIND=JPRB) :: ZTMP2(KFDIA-KIDIA+1+N_VMASS)
83
84INTEGER(KIND=JPIM) ::  JA, JL, IEXP, JX, JLEN
85REAL(KIND=JPRB) :: ZHOOK_HANDLE
86LOGICAL LLDEBUG
87
88IF (LHOOK) CALL DR_HOOK('SWUVO3',0,ZHOOK_HANDLE)
89IEXP=NEXPO3(KNU)
90LLDEBUG=.FALSE.
91
92!print *,'Dans SWUVO3, N_VMASS= ',N_VMASS
93IF(N_VMASS > 0) THEN
94  JLEN=KFDIA-KIDIA+N_VMASS-MOD(KFDIA-KIDIA,N_VMASS)
95  IF(KFDIA-KIDIA+1 /= JLEN) THEN
96    ZTMP1(KFDIA-KIDIA+2:JLEN) = 0.0_JPRB
97  ENDIF
98ENDIF
99
100DO JA = 1,KABS
101  DO JL=KIDIA,KFDIA
102    PTR(JL,JA)=0.0_JPRB
103  ENDDO
104 
105! Ce qui concerne N_VMASS commente par MPL 20.11.08
106! IF(N_VMASS <= 0) THEN ! Do not use Vector Mass
107
108!       WRITE(*,'("---> Dans SWUVO3 ")')
109    DO JX=1,IEXP
110      DO JL = KIDIA,KFDIA
111        ZU(JL) = PU(JL,JA)
112        PTR(JL,JA) = PTR(JL,JA)+REXPO3(KNU,1,JX)*EXP(-REXPO3(KNU,2,JX)*ZU(JL))
113!       WRITE(*,'("                 PTR ",E12.5)') (PTR(JL,JA))
114!       WRITE(*,'("REXPO3-1 ",E12.5)') (REXPO3(KNU,1,JX))
115!       WRITE(*,'("REXPO3-2 ",E12.5)') (REXPO3(KNU,2,JX))
116!       WRITE(*,'("ZU ",E12.5)') (ZU(JL))
117!       WRITE(*,'("KNU KABS IEXP ",3I6)') KNU,KABS,IEXP
118      ENDDO
119    ENDDO
120
121
122! ELSE  ! Use Vector MASS
123
124!   DO JX=1,IEXP
125!     DO JL = KIDIA,KFDIA
126!       ZTMP1(JL-KIDIA+1)=-REXPO3(KNU,2,JX)*PU(JL,JA)
127!     ENDDO
128 
129!     CALL VEXP(ZTMP2,ZTMP1,JLEN)
130 
131!     DO JL = KIDIA,KFDIA
132!       PTR(JL,JA) = PTR(JL,JA)+REXPO3(KNU,1,JX)*ZTMP2(JL-KIDIA+1)
133!     ENDDO
134!   ENDDO   
135
136! ENDIF
137
138ENDDO
139
140IF(LLDEBUG) THEN
141    call writefield_phy("swuvo3_pu",pu,kabs)
142    call writefield_phy("swuvo3_ptr",ptr,kabs)
143ENDIF
144
145IF (LHOOK) CALL DR_HOOK('SWUVO3',1,ZHOOK_HANDLE)
146END SUBROUTINE SWUVO3
Note: See TracBrowser for help on using the repository browser.