source: LMDZ5/branches/IPSLCM6.0.11pre/libf/phymar/swuvo3.F90 @ 5024

Last change on this file since 5024 was 2089, checked in by Laurent Fairhead, 10 years ago

Inclusion de la physique de MAR


Integration of MAR physics

File size: 2.2 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
18!        EXPLICIT ARGUMENTS :
19!        --------------------
20! KNU    :                     ; INDEX OF THE SPECTRAL INTERVAL
21! KABS   :                     ; NUMBER OF ABSORBERS
22! PU     : (KLON,KABS)         ; ABSORBER AMOUNT
23!     ==== OUTPUTS ===
24! PTR    : (KLON,KABS)         ; TRANSMISSION FUNCTION
25
26!        IMPLICIT ARGUMENTS :   NONE
27!        --------------------
28
29!     METHOD.
30!     -------
31
32!          TRANSMISSION FUNCTION ARE COMPUTED USING SUMS OF EXPONENTIALS
33
34!     EXTERNALS.
35!     ----------
36
37!          NONE
38
39!     REFERENCE.
40!     ----------
41!        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
42!        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
43
44!     AUTHOR.
45!     -------
46!        JEAN-JACQUES MORCRETTE  *ECMWF*
47!        Ph.DUBUISSON/B.BONNEL L.O.A.
48
49!     MODIFICATIONS.
50!     --------------
51!        ORIGINAL : 00-12-18
52   
53!-----------------------------------------------------------------------
54
55#include "tsmbkind.h"
56
57USE YOESW    , ONLY : NEXPO3, REXPO3
58
59
60IMPLICIT NONE
61
62
63!     DUMMY INTEGER SCALARS
64INTEGER_M :: KABS
65INTEGER_M :: KFDIA
66INTEGER_M :: KIDIA
67INTEGER_M :: KLON
68INTEGER_M :: KNU
69
70!-----------------------------------------------------------------------
71
72!*       0.1   ARGUMENTS
73!              ---------
74
75REAL_B :: PU(KLON,KABS)
76REAL_B :: PTR(KLON,KABS)
77
78!-----------------------------------------------------------------------
79
80!*       0.2   LOCAL ARRAYS
81!              ------------
82
83!     LOCAL INTEGER SCALARS
84INTEGER_M :: JA, JL, IEXP, JX
85
86
87IEXP=NEXPO3(KNU)
88!print *,'IEXP(',KNU,')=',IEXP
89!print *,(REXPO3(KNU,1,JX),JX=1,IEXP)
90!print *,(REXPO3(KNU,2,JX),JX=1,IEXP)
91
92DO JA = 1,KABS
93  DO JL=KIDIA,KFDIA
94    PTR(JL,JA)=_ZERO_
95  END DO
96   
97  DO JX=1,IEXP
98    DO JL = KIDIA,KFDIA
99      PTR(JL,JA) = PTR(JL,JA) &
100        &+REXPO3(KNU,1,JX)*EXP(-min(REXPO3(KNU,2,JX)*PU(JL,JA),200.0_JPRB))
101    END DO
102  END DO   
103ENDDO
104
105RETURN
106END SUBROUTINE SWUVO3
Note: See TracBrowser for help on using the repository browser.