GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: phylmd/rrtm/lwu.F90 Lines: 0 141 0.0 %
Date: 2023-06-30 12:56:34 Branches: 0 44 0.0 %

Line Branch Exec Source
1
!
2
! $Id: lwu.F90 4389 2023-01-23 10:28:51Z dcugnet $
3
!
4
SUBROUTINE LWU &
5
 & ( KIDIA, KFDIA, KLON, KLEV,&
6
 & PAER , PCCO2, PDP , PPMB, PQOF , PTAVE, PVIEW, PWV,&
7
 & PABCU &
8
 & )
9
10
!**** *LWU* - LONGWAVE EFFECTIVE ABSORBER AMOUNTS
11
12
!     PURPOSE.
13
!     --------
14
!           COMPUTES ABSORBER AMOUNTS INCLUDING PRESSURE AND
15
!           TEMPERATURE EFFECTS
16
17
!**   INTERFACE.
18
!     ----------
19
20
!        EXPLICIT ARGUMENTS :
21
!        --------------------
22
!     ==== INPUTS ===
23
! PAER   : (KLON,6,KLEV)     ; OPTICAL THICKNESS OF THE AEROSOLS
24
! PCCO2  :                   ; CONCENTRATION IN CO2 (PA/PA)
25
! PDP    : (KLON,KLEV)       ; LAYER PRESSURE THICKNESS (PA)
26
! PPMB   : (KLON,KLEV+1)     ; HALF LEVEL PRESSURE
27
! PQOF   : (KLON,KLEV)       ; CONCENTRATION IN OZONE (PA/PA)
28
! PTAVE  : (KLON,KLEV)       ; TEMPERATURE
29
! PWV    : (KLON,KLEV)       ; SPECIFIC HUMIDITY PA/PA
30
! PVIEW  : (KLON)            ; COSECANT OF VIEWING ANGLE
31
!     ==== OUTPUTS ===
32
! PABCU  :(KLON,NUA,3*KLEV+1); EFFECTIVE ABSORBER AMOUNTS
33
34
!        IMPLICIT ARGUMENTS :   NONE
35
!        --------------------
36
37
!     METHOD.
38
!     -------
39
40
!          1. COMPUTES THE PRESSURE AND TEMPERATURE WEIGHTED AMOUNTS OF
41
!     ABSORBERS.
42
43
!     EXTERNALS.
44
!     ----------
45
46
!          NONE
47
48
!     REFERENCE.
49
!     ----------
50
51
!        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
52
!        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
53
54
!     AUTHOR.
55
!     -------
56
!        JEAN-JACQUES MORCRETTE  *ECMWF*
57
58
!     MODIFICATIONS.
59
!     --------------
60
!        ORIGINAL : 89-07-14
61
!        JJ Morcrette 97-04-18 Revised Continuum + Clean-up
62
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
63
64
!-----------------------------------------------------------------------
65
66
USE PARKIND1  ,ONLY : JPIM     ,JPRB
67
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
68
69
USE YOMCST   , ONLY : RG
70
USE YOESW    , ONLY : RAER
71
USE YOELW    , ONLY : NSIL     ,NUA      ,NG1      ,NG1P1    ,&
72
 & ALWT     ,BLWT     ,RO3T     ,RT1      ,TREF     ,&
73
 & RVGCO2   ,RVGH2O   ,RVGO3
74
!USE YOERDI   , ONLY : RCH4     ,RN2O     ,RCFC11   ,RCFC12
75
USE YOERDU   , ONLY : R10E     ,REPSCO   ,REPSCQ
76
#ifdef REPROBUS
77
USE chem_rep, ONLY: rch42d, rn2o2d, rcfc112d, rcfc122d, ok_rtime2d
78
USE infotrac_phy, ONLY : type_trac
79
#endif
80
81
82
IMPLICIT NONE
83
84
INTEGER(KIND=JPIM),INTENT(IN)    :: KLON
85
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
86
INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
87
INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
88
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAER(KLON,6,KLEV)
89
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCCO2
90
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDP(KLON,KLEV)
91
REAL(KIND=JPRB)   ,INTENT(IN)    :: PPMB(KLON,KLEV+1)
92
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQOF(KLON,KLEV)
93
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAVE(KLON,KLEV)
94
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVIEW(KLON)
95
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWV(KLON,KLEV)
96
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PABCU(KLON,NUA,3*KLEV+1)
97
98
#include "clesphys.h"
99
!-----------------------------------------------------------------------
100
101
!*       0.1   ARGUMENTS
102
!              ---------
103
104
!-----------------------------------------------------------------------
105
106
!              ------------
107
REAL(KIND=JPRB) :: ZABLY(KLON,7,3*KLEV+1)  , ZDPM(KLON,3*KLEV)&
108
 & ,  ZDUC(KLON, 3*KLEV+1)    , ZFACT(KLON)&
109
 & ,  ZUPM(KLON,3*KLEV)
110
REAL(KIND=JPRB) :: ZPHIO(KLON),ZPSC2(KLON) , ZPSC3(KLON), ZPSH1(KLON)&
111
 & ,  ZPSH2(KLON),ZPSH3(KLON) , ZPSH4(KLON), ZPSH5(KLON)&
112
 & ,  ZPSH6(KLON),ZPSIO(KLON) , ZTCON(KLON)&
113
 & ,  ZPHM6(KLON),ZPSM6(KLON) , ZPHN6(KLON), ZPSN6(KLON)
114
REAL(KIND=JPRB) :: ZSSIG(KLON,3*KLEV+1)    , ZTAVI(KLON)&
115
 & ,  ZUAER(KLON,NSIL)        , ZXOZ(KLON) , ZXWV(KLON)
116
117
INTEGER(KIND=JPIM) :: IAE1, IAE2, IAE3, IC, ICP1, IG1, IJ, IJPN,&
118
 & IKIP1, IKJ, IKJP, IKJPN, IKJR, IKL, JA, JAE, &
119
 & JK, JKI, JKK, JL
120
121
REAL(KIND=JPRB) :: ZALUP, ZCAC8, ZCAH1, ZCAH2, ZCAH3, ZCAH4,&
122
 & ZCAH5, ZCAH6, ZCBC8, ZCBH1, ZCBH2, ZCBH3, &
123
 & ZCBH4, ZCBH5, ZCBH6, ZDIFF, ZDPMG, ZDPMP0, &
124
 & ZFPPW, ZTX, ZTX2, ZU6, ZUP, ZUPMCO2, ZUPMG, &
125
 & ZUPMH2O, ZUPMO3, ZZABLY
126
REAL(KIND=JPRB) :: ZHOOK_HANDLE
127
128
129
!-----------------------------------------------------------------------
130
131
!*         1.    INITIALIZATION
132
!                --------------
133
134
!-----------------------------------------------------------------------
135
136
!*         2.    PRESSURE OVER GAUSS SUB-LEVELS
137
!                ------------------------------
138
139
IF (LHOOK) CALL DR_HOOK('LWU',0,ZHOOK_HANDLE)
140
DO JL = KIDIA,KFDIA
141
  ZSSIG(JL, 1 ) = PPMB(JL,1) * 100._JPRB
142
ENDDO
143
144
DO JK = 1 , KLEV
145
  IKJ=(JK-1)*NG1P1+1
146
  IKJR = IKJ
147
  IKJP = IKJ + NG1P1
148
  DO JL = KIDIA,KFDIA
149
    ZSSIG(JL,IKJP)=PPMB(JL,JK+1)* 100._JPRB
150
  ENDDO
151
  DO IG1=1,NG1
152
    IKJ=IKJ+1
153
    DO JL = KIDIA,KFDIA
154
      ZSSIG(JL,IKJ)= (ZSSIG(JL,IKJR) + ZSSIG(JL,IKJP)) * 0.5_JPRB &
155
       & + RT1(IG1) * (ZSSIG(JL,IKJP) - ZSSIG(JL,IKJR)) * 0.5_JPRB
156
    ENDDO
157
  ENDDO
158
ENDDO
159
160
!-----------------------------------------------------------------------
161
162
!*         4.    PRESSURE THICKNESS AND MEAN PRESSURE OF SUB-LAYERS
163
!                --------------------------------------------------
164
165
DO JKI=1,3*KLEV
166
  IKIP1=JKI+1
167
  DO JL = KIDIA,KFDIA
168
    ZUPM(JL,JKI)=(ZSSIG(JL,JKI)+ZSSIG(JL,IKIP1))*0.5_JPRB
169
    ZDPM(JL,JKI)=(ZSSIG(JL,JKI)-ZSSIG(JL,IKIP1))/(10._JPRB*RG)
170
  ENDDO
171
ENDDO
172
173
DO JK = 1 , KLEV
174
  IKL = KLEV+1 - JK
175
  DO JL = KIDIA,KFDIA
176
    ZXWV(JL) = MAX (PWV(JL,IKL) , REPSCQ )
177
    ZXOZ(JL) = MAX (PQOF(JL,IKL) / PDP(JL,IKL) , REPSCO )
178
  ENDDO
179
  IKJ=(JK-1)*NG1P1+1
180
  IKJPN=IKJ+NG1
181
  DO JKK=IKJ,IKJPN
182
    DO JL = KIDIA,KFDIA
183
      ZDPMG = ZDPM(JL,JKK)
184
      ZDPMP0 = ZDPMG / 101325._JPRB
185
      ZUPMG = ZUPM(JL,JKK) * ZDPMP0
186
      ZUPMCO2 = ( ZUPM(JL,JKK) + RVGCO2 ) * ZDPMP0
187
      ZUPMH2O = ( ZUPM(JL,JKK) + RVGH2O ) * ZDPMP0
188
      ZUPMO3  = ( ZUPM(JL,JKK) + RVGO3  ) * ZDPMP0
189
      ZDUC(JL,JKK) = ZDPMG
190
      ZABLY(JL,6,JKK) = ZXOZ(JL) * ZDPMG
191
      ZABLY(JL,7,JKK) = ZXOZ(JL) * ZUPMO3
192
      ZU6 = ZXWV(JL) * ZUPMG
193
      ZFPPW = 1.6078_JPRB * ZXWV(JL) / (1.0_JPRB+0.608_JPRB*ZXWV(JL))
194
      ZABLY(JL,1,JKK)  = ZXWV(JL) * ZUPMH2O
195
      ZABLY(JL,5,JKK) = ZU6 * ZFPPW
196
      ZABLY(JL,4,JKK) = ZU6 * (1.0_JPRB-ZFPPW)
197
      ZABLY(JL,3,JKK)  = PCCO2 * ZUPMCO2
198
      ZABLY(JL,2,JKK)  = PCCO2 * ZDPMG
199
    ENDDO
200
  ENDDO
201
ENDDO
202
203
!-----------------------------------------------------------------------
204
205
!*         5.    CUMULATIVE ABSORBER AMOUNTS FROM TOP OF ATMOSPHERE
206
!                --------------------------------------------------
207
208
DO JA = 1, NUA
209
  DO JL = KIDIA,KFDIA
210
    PABCU(JL,JA,3*KLEV+1) = 0.0_JPRB
211
  ENDDO
212
ENDDO
213
214
DO JK = 1 , KLEV
215
  IJ=(JK-1)*NG1P1+1
216
  IJPN=IJ+NG1
217
  IKL=KLEV+1-JK
218
219
!*         5.1  CUMULATIVE AEROSOL AMOUNTS FROM TOP OF ATMOSPHERE
220
!               --------------------------------------------------
221
! --            NB: 'PAER' AEROSOLS ARE ENTERED FROM TOP TO BOTTOM
222
223
  IAE1=3*KLEV+1-IJ
224
  IAE2=3*KLEV+1-(IJ+1)
225
  IAE3=3*KLEV+1-IJPN
226
! print *,'IAE1= ',IAE1
227
! print *,'IAE2= ',IAE2
228
! print *,'IAE3= ',IAE3
229
! print *,'KIDIA= ',KIDIA
230
! print *,'KFDIA= ',KFDIA
231
! print *,'KLEV= ',KLEV
232
  DO JAE=1,6
233
    DO JL = KIDIA,KFDIA
234
!   print *,'JL= ',JL,'-JAE= ',JAE,'-JK= ',JK,'-NSIL= ',NSIL
235
      ZUAER(JL,JAE) =&
236
       & (RAER(JAE,1)*PAER(JL,1,JK)+RAER(JAE,2)*PAER(JL,2,JK)&
237
       & +RAER(JAE,3)*PAER(JL,3,JK)+RAER(JAE,4)*PAER(JL,4,JK)&
238
       & +RAER(JAE,5)*PAER(JL,5,JK)+RAER(JAE,6)*PAER(JL,6,JK))&
239
       & /(ZDUC(JL,IAE1)+ZDUC(JL,IAE2)+ZDUC(JL,IAE3))
240
    ENDDO
241
  ENDDO
242
243
!*         5.2  INTRODUCES TEMPERATURE EFFECTS ON ABSORBER AMOUNTS
244
!               --------------------------------------------------
245
246
  DO JL = KIDIA,KFDIA
247
    ZTAVI(JL)=PTAVE(JL,IKL)
248
    ZFACT(JL)=1.0_JPRB-ZTAVI(JL)/296._JPRB
249
    ZTCON(JL)=EXP(6.08_JPRB*(296._JPRB/ZTAVI(JL)-1.0_JPRB))
250
!     ZTCON(JL)=EXP(6.08*ZFACT(JL))
251
    ZTX=ZTAVI(JL)-TREF
252
    ZTX2=ZTX*ZTX
253
    ZZABLY = ZABLY(JL,1,IAE1)+ZABLY(JL,1,IAE2)+ZABLY(JL,1,IAE3)
254
    ZUP=MIN( MAX( 0.5_JPRB*R10E*LOG( ZZABLY ) + 5._JPRB, 0.0_JPRB), 6.0_JPRB)
255
    ZCAH1=ALWT(1,1)+ZUP*(ALWT(1,2)+ZUP*(ALWT(1,3)))
256
    ZCBH1=BLWT(1,1)+ZUP*(BLWT(1,2)+ZUP*(BLWT(1,3)))
257
    ZPSH1(JL)=EXP( ZCAH1 * ZTX + ZCBH1 * ZTX2 )
258
    ZCAH2=ALWT(2,1)+ZUP*(ALWT(2,2)+ZUP*(ALWT(2,3)))
259
    ZCBH2=BLWT(2,1)+ZUP*(BLWT(2,2)+ZUP*(BLWT(2,3)))
260
    ZPSH2(JL)=EXP( ZCAH2 * ZTX + ZCBH2 * ZTX2 )
261
    ZCAH3=ALWT(3,1)+ZUP*(ALWT(3,2)+ZUP*(ALWT(3,3)))
262
    ZCBH3=BLWT(3,1)+ZUP*(BLWT(3,2)+ZUP*(BLWT(3,3)))
263
    ZPSH3(JL)=EXP( ZCAH3 * ZTX + ZCBH3 * ZTX2 )
264
    ZCAH4=ALWT(4,1)+ZUP*(ALWT(4,2)+ZUP*(ALWT(4,3)))
265
    ZCBH4=BLWT(4,1)+ZUP*(BLWT(4,2)+ZUP*(BLWT(4,3)))
266
    ZPSH4(JL)=EXP( ZCAH4 * ZTX + ZCBH4 * ZTX2 )
267
    ZCAH5=ALWT(5,1)+ZUP*(ALWT(5,2)+ZUP*(ALWT(5,3)))
268
    ZCBH5=BLWT(5,1)+ZUP*(BLWT(5,2)+ZUP*(BLWT(5,3)))
269
    ZPSH5(JL)=EXP( ZCAH5 * ZTX + ZCBH5 * ZTX2 )
270
    ZCAH6=ALWT(6,1)+ZUP*(ALWT(6,2)+ZUP*(ALWT(6,3)))
271
    ZCBH6=BLWT(6,1)+ZUP*(BLWT(6,2)+ZUP*(BLWT(6,3)))
272
    ZPSH6(JL)=EXP( ZCAH6 * ZTX + ZCBH6 * ZTX2 )
273
    ZPHM6(JL)=EXP(-5.81E-4_JPRB * ZTX - 1.13E-6_JPRB * ZTX2 )
274
    ZPSM6(JL)=EXP(-5.57E-4_JPRB * ZTX - 3.30E-6_JPRB * ZTX2 )
275
    ZPHN6(JL)=EXP(-3.46E-5_JPRB * ZTX + 2.05E-7_JPRB * ZTX2 )
276
    ZPSN6(JL)=EXP( 3.70E-3_JPRB * ZTX - 2.30E-6_JPRB * ZTX2 )
277
  ENDDO
278
279
  DO JL = KIDIA,KFDIA
280
    ZTAVI(JL)=PTAVE(JL,IKL)
281
    ZTX=ZTAVI(JL)-TREF
282
    ZTX2=ZTX*ZTX
283
    ZZABLY = ZABLY(JL,3,IAE1)+ZABLY(JL,3,IAE2)+ZABLY(JL,3,IAE3)
284
    ZALUP = R10E * LOG ( ZZABLY )
285
    ZUP   = MAX( 0.0_JPRB , 5.0_JPRB + 0.5_JPRB * ZALUP )
286
    ZPSC2(JL) = (ZTAVI(JL)/TREF) ** ZUP
287
    ZCAC8=ALWT(8,1)+ZUP*(ALWT(8,2)+ZUP*(ALWT(8,3)))
288
    ZCBC8=BLWT(8,1)+ZUP*(BLWT(8,2)+ZUP*(BLWT(8,3)))
289
    ZPSC3(JL)=EXP( ZCAC8 * ZTX + ZCBC8 * ZTX2 )
290
    ZPHIO(JL) = EXP( RO3T(1) * ZTX + RO3T(2) * ZTX2)
291
    ZPSIO(JL) = EXP( 2.0_JPRB* (RO3T(3)*ZTX+RO3T(4)*ZTX2))
292
  ENDDO
293
294
  DO JKK=IJ,IJPN
295
    IC=3*KLEV+1-JKK
296
    ICP1=IC+1
297
    DO JL = KIDIA,KFDIA
298
      ZDIFF = PVIEW(JL)
299
!- H2O continuum
300
      PABCU(JL,10,IC)=PABCU(JL,10,ICP1)+ ZABLY(JL,4,IC)          *ZDIFF
301
      PABCU(JL,11,IC)=PABCU(JL,11,ICP1)+ ZABLY(JL,5,IC)*ZTCON(JL)*ZDIFF
302
!- O3
303
      PABCU(JL,12,IC)=PABCU(JL,12,ICP1)+ ZABLY(JL,6,IC)*ZPHIO(JL)*ZDIFF
304
      PABCU(JL,13,IC)=PABCU(JL,13,ICP1)+ ZABLY(JL,7,IC)*ZPSIO(JL)*ZDIFF
305
!- CO2
306
      PABCU(JL,7,IC)=PABCU(JL,7,ICP1)+ ZABLY(JL,3,IC)*ZPSC2(JL)*ZDIFF
307
      PABCU(JL,8,IC)=PABCU(JL,8,ICP1)+ ZABLY(JL,3,IC)*ZPSC3(JL)*ZDIFF
308
      PABCU(JL,9,IC)=PABCU(JL,9,ICP1)+ ZABLY(JL,3,IC)*ZPSC3(JL)*ZDIFF
309
!- H2O
310
      PABCU(JL,1,IC)=PABCU(JL,1,ICP1)+ ZABLY(JL,1,IC)*ZPSH1(JL)
311
      PABCU(JL,2,IC)=PABCU(JL,2,ICP1)+ ZABLY(JL,1,IC)*ZPSH2(JL)
312
      PABCU(JL,3,IC)=PABCU(JL,3,ICP1)+ ZABLY(JL,1,IC)*ZPSH5(JL)*ZDIFF
313
      PABCU(JL,4,IC)=PABCU(JL,4,ICP1)+ ZABLY(JL,1,IC)*ZPSH3(JL)
314
      PABCU(JL,5,IC)=PABCU(JL,5,ICP1)+ ZABLY(JL,1,IC)*ZPSH4(JL)
315
      PABCU(JL,6,IC)=PABCU(JL,6,ICP1)+ ZABLY(JL,1,IC)*ZPSH6(JL)*ZDIFF
316
!- aerosols
317
      PABCU(JL,14,IC)=PABCU(JL,14,ICP1)+ ZUAER(JL,1)    *ZDUC(JL,IC)*ZDIFF
318
      PABCU(JL,15,IC)=PABCU(JL,15,ICP1)+ ZUAER(JL,2)    *ZDUC(JL,IC)*ZDIFF
319
      PABCU(JL,16,IC)=PABCU(JL,16,ICP1)+ ZUAER(JL,3)    *ZDUC(JL,IC)*ZDIFF
320
      PABCU(JL,17,IC)=PABCU(JL,17,ICP1)+ ZUAER(JL,4)    *ZDUC(JL,IC)*ZDIFF
321
      PABCU(JL,18,IC)=PABCU(JL,18,ICP1)+ ZUAER(JL,5)    *ZDUC(JL,IC)*ZDIFF
322
#ifdef REPROBUS
323
        IF (type_trac=='repr'.and. ok_rtime2d) THEN
324
!- CH4
325
      PABCU(JL,19,IC)=PABCU(JL,19,ICP1)&
326
       & + ZABLY(JL,2,IC)*RCH42D(JL, IC)/PCCO2*ZPHM6(JL)*ZDIFF
327
      PABCU(JL,20,IC)=PABCU(JL,20,ICP1)&
328
       & + ZABLY(JL,3,IC)*RCH42D(JL, IC)/PCCO2*ZPSM6(JL)*ZDIFF
329
!- N2O
330
      PABCU(JL,21,IC)=PABCU(JL,21,ICP1)&
331
       & + ZABLY(JL,2,IC)*RN2O2D(JL, IC)/PCCO2*ZPHN6(JL)*ZDIFF
332
      PABCU(JL,22,IC)=PABCU(JL,22,ICP1)&
333
       & + ZABLY(JL,3,IC)*RN2O2D(JL, IC)/PCCO2*ZPSN6(JL)*ZDIFF
334
!- CFC11
335
      PABCU(JL,23,IC)=PABCU(JL,23,ICP1)&
336
       & + ZABLY(JL,2,IC)*RCFC112D(JL, IC)/PCCO2        *ZDIFF
337
!- CFC12
338
      PABCU(JL,24,IC)=PABCU(JL,24,ICP1)&
339
       & + ZABLY(JL,2,IC)*RCFC122D(JL, IC)/PCCO2        *ZDIFF
340
341
         ELSE
342
#endif
343
!- CH4
344
      PABCU(JL,19,IC)=PABCU(JL,19,ICP1)&
345
       & + ZABLY(JL,2,IC)*RCH4/PCCO2*ZPHM6(JL)*ZDIFF
346
      PABCU(JL,20,IC)=PABCU(JL,20,ICP1)&
347
       & + ZABLY(JL,3,IC)*RCH4/PCCO2*ZPSM6(JL)*ZDIFF
348
!- N2O
349
      PABCU(JL,21,IC)=PABCU(JL,21,ICP1)&
350
       & + ZABLY(JL,2,IC)*RN2O/PCCO2*ZPHN6(JL)*ZDIFF
351
      PABCU(JL,22,IC)=PABCU(JL,22,ICP1)&
352
       & + ZABLY(JL,3,IC)*RN2O/PCCO2*ZPSN6(JL)*ZDIFF
353
!- CFC11
354
      PABCU(JL,23,IC)=PABCU(JL,23,ICP1)&
355
       & + ZABLY(JL,2,IC)*RCFC11/PCCO2        *ZDIFF
356
!- CFC12
357
      PABCU(JL,24,IC)=PABCU(JL,24,ICP1)&
358
       & + ZABLY(JL,2,IC)*RCFC12/PCCO2        *ZDIFF
359
#ifdef REPROBUS
360
        END IF
361
#endif
362
    ENDDO
363
  ENDDO
364
365
ENDDO
366
!      print *,'END OF LWU'
367
368
369
370
!-----------------------------------------------------------------------
371
372
IF (LHOOK) CALL DR_HOOK('LWU',1,ZHOOK_HANDLE)
373
END SUBROUTINE LWU