1 |
|
16848 |
SUBROUTINE SWUVO3 & |
2 |
|
|
& ( KIDIA,KFDIA,KLON,KNU,KABS,& |
3 |
|
16848 |
& 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 |
|
|
|
55 |
|
|
USE PARKIND1 ,ONLY : JPIM ,JPRB |
56 |
|
|
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK |
57 |
|
|
|
58 |
|
|
USE YOESW , ONLY : NEXPO3, REXPO3 |
59 |
|
|
USE YOMJFH , ONLY : N_VMASS |
60 |
|
|
USE write_field_phy |
61 |
|
|
|
62 |
|
|
IMPLICIT NONE |
63 |
|
|
|
64 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KLON |
65 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KABS |
66 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA |
67 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA |
68 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KNU |
69 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PU(KLON,KABS) |
70 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PTR(KLON,KABS) |
71 |
|
|
!----------------------------------------------------------------------- |
72 |
|
|
|
73 |
|
|
!* 0.1 ARGUMENTS |
74 |
|
|
! --------- |
75 |
|
|
|
76 |
|
|
!----------------------------------------------------------------------- |
77 |
|
|
|
78 |
|
|
! ------------ |
79 |
|
|
|
80 |
|
33696 |
REAL(KIND=JPRB) :: ZU(KLON) |
81 |
|
33696 |
REAL(KIND=JPRB) :: ZTMP1(KFDIA-KIDIA+1+N_VMASS) |
82 |
|
|
REAL(KIND=JPRB) :: ZTMP2(KFDIA-KIDIA+1+N_VMASS) |
83 |
|
|
|
84 |
|
|
INTEGER(KIND=JPIM) :: JA, JL, IEXP, JX, JLEN |
85 |
|
|
REAL(KIND=JPRB) :: ZHOOK_HANDLE |
86 |
|
|
LOGICAL LLDEBUG |
87 |
|
|
|
88 |
✓✗ |
16848 |
IF (LHOOK) CALL DR_HOOK('SWUVO3',0,ZHOOK_HANDLE) |
89 |
|
16848 |
IEXP=NEXPO3(KNU) |
90 |
|
|
LLDEBUG=.FALSE. |
91 |
|
|
|
92 |
|
|
!print *,'Dans SWUVO3, N_VMASS= ',N_VMASS |
93 |
✗✓ |
16848 |
IF(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 |
98 |
|
|
ENDIF |
99 |
|
|
|
100 |
✓✓ |
50544 |
DO JA = 1,KABS |
101 |
✓✓ |
33527520 |
DO JL=KIDIA,KFDIA |
102 |
|
33527520 |
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 |
✓✓ |
275184 |
DO JX=1,IEXP |
110 |
✓✓ |
223550496 |
DO JL = KIDIA,KFDIA |
111 |
|
223292160 |
ZU(JL) = PU(JL,JA) |
112 |
|
223516800 |
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 |
|
|
|
138 |
|
|
ENDDO |
139 |
|
|
|
140 |
|
|
IF(LLDEBUG) THEN |
141 |
|
|
call writefield_phy("swuvo3_pu",pu,kabs) |
142 |
|
|
call writefield_phy("swuvo3_ptr",ptr,kabs) |
143 |
|
|
ENDIF |
144 |
|
|
|
145 |
✓✗ |
16848 |
IF (LHOOK) CALL DR_HOOK('SWUVO3',1,ZHOOK_HANDLE) |
146 |
|
16848 |
END SUBROUTINE SWUVO3 |