source: LMDZ5/trunk/libf/phymar/Atm_RT_RUN.F90 @ 4735

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

Inclusion de la physique de MAR


Integration of MAR physics

File size: 31.3 KB
RevLine 
[2089]1      subroutine Atm_RT_RUN(rklonr,iklOUT)
2
3!--------------------------------------------------------------------------+
4!                                                     Mon 24-Jun-2013  MAR |
5!     subroutine Atm_RT_RUN interfaces MAR PHYsics                         |
6!           with ECMWF Solar/Infrared   Radiative  Transfer Scheme         |
7!                                                                          |
8!     version 3.p.4.1 created by H. Gallee,           Tue  2-Apr-2013      |
9!           Last Modification by H. Gallee,           Mon 24-Jun-2013      |
10!                                                                          |
11!--------------------------------------------------------------------------+
12!                                                                          |
13!     Content:   CALL of - ECMWF Code initializing the Radiation Transfert |
14!                        - ECMWF                       Radiation Transfert |
15!                                                                          |
16!     ECMWF Code Source:  J.-J. Morcrette, 28 nov 2002                     |
17!                                                                          |
18!--------------------------------------------------------------------------+
19
20      use Mod_Real
21      use Mod_PHY____dat
22      use Mod_PHY_RT_dat
23      use Mod_PHY____grd
24      use Mod_PHY_S0_grd
25      use Mod_PHY_RT_grd
26      use Mod_PHY_S0_kkl
27      use Mod_PHY_RT_kkl
28      use Mod_PHY_DY_kkl
29      use Mod_PHY_CM_kkl
30      use Mod_SISVAT_gpt
31
32
33#include "tsmbkind.h"
34
35
36
37! Global Variables (ECMWF)
38! ========================
39
40USE PARRTM1D , ONLY : JP_LON   ,JP_IDIA  ,JP_FDIA  ,JP_TDIA  ,&
41 &            JP_LEV ,JP_LW    ,JP_SW    ,JP_NUA   ,JP_MODE  ,&
42 &            JP_AER ,JP_LEVP1
43USE YOMCST   , ONLY : RD       ,RG       ,RTT      ,RSIGMA   ,&
44 &            RCPD   ,RPI      ,RDAY     ,REA      ,RI0      ,&
45 &            REPSM  ,RMD      ,RKBOL    ,RNAVO    ,R        ,&
46 &            RLVTT  ,RLSTT
47USE YOERAD   , ONLY : NSW      ,NTSW     ,NRADFR             ,&
48 &            LRRTM  ,LINHOM   ,LOIFUEC  ,LTEMPDS  ,LOWASYF  ,&
49 &            LOWHSSS,LONEWSW  ,LNEWAER  ,LHVOLCA            ,&
50 &            NRADIP ,NRADLP   ,NOZOCL                       ,&
51 &            NICEOPT,NLIQOPT  ,NOVLP    ,NHOWINH  ,RMINICE
52USE YOEAERD  , ONLY : CVDAES   ,CVDAEL   ,CVDAEU   ,CVDAED            ,&
53 &            RCTRBGA,RCVOBGA  ,RCSTBGA  ,RCAEOPS  ,RCAEOPL  ,RCAEOPU ,&
54 &            RCAEOPD,RCTRPT   ,RCAEADK  ,RCAEADM  ,RCAEROS
55USE YOERDI   , ONLY : RCH4     ,RN2O     ,RO3      ,RCFC11   ,&
56 &                                                  RCFC12
57USE YOERDU   , ONLY : RCDAY    ,R10E     ,DIFF     ,REPLOG   ,&
58 &            REPSC  ,REPSCO   ,REPSCQ   ,REPSCT   ,REPSCW   ,&
59 &            NTRAER
60USE YOETHF   , ONLY : R2ES     ,R3LES    ,R3IES    ,R4LES    ,&
61 &            R4IES  ,R5LES    ,R5IES    ,R5ALVCP  ,R5ALSCP  ,&
62 &            RALVDCP,RALSDCP  ,RTWAT    ,RTICE    ,RTICECU
63
64
65
66      IMPLICIT NONE
67
68      logical                      ::  RTi_qi_and_qs = .TRUE.           ! * as Very small Cloud Particle: T
69!Gilles: T > F to have interactive cloud frac. & radiation
70      logical                      ::  CFrCEP        = .FALSE.          ! ECMWF or CMiPhy Cloud Fraction: T OR F
71
72
73
74!  INPUT (from MAR/ECMWF Interface)
75!  -----
76
77      integer                      ::  rklonr                           ! nb    des pts de grilles
78      integer                      ::  iklOUT                           ! OUTPUT   (pt  de grille)
79
80      integer                      ::  kj                               ! Index des niveaux
81      integer                      ::  nAe                              ! Index d'aerosols
82
83! #DB integer                      ::  kio
84! #DB integer                      ::  kjo
85      integer, dimension(rklonr)   ::  k2ii                             !
86      integer, dimension(rklonr)   ::  k2jj                             !
87! #DB integer                      ::  jkjllw     
88! #DB integer                      ::  lijio
89
90
91
92!  INTERNAL VARIABLES
93!  ------------------
94
95!   For Use in radlsw
96!   ^^^^^^^^^^^^^^^^^
97      REAL_B    ::   PGELAM5(JP_LON)
98      REAL_B    ::    PGEMU5(JP_LON)
99      REAL_B    ::    PSLON5(JP_LON)
100      REAL_B    ::    PCLON5(JP_LON)
101      REAL_B    ::    ZOZON5(JP_LON,JP_LEV)
102      REAL_B    ::     ZAER5(JP_LON,JP_AER,JP_LEV)
103!
104!
105      INTEGER_M :: KIDIA ,KFDIA ,KTDIA ,KLON  ,KLEV 
106      INTEGER_M :: KMODE ,KAER  ,KSW
107
108      INTEGER_M :: KBOX  ,NBOX
109      INTEGER_M :: NDUMP ,ILWRAD
110!
111      REAL_B    ::    PRII05
112
113      REAL_B    ::     PAER5(JP_LON,JP_AER,JP_LEV)   ! Aerosol Optical Depth
114      REAL_B    ::    PALBD5(JP_LON,JP_SW) 
115      REAL_B    ::    PALBP5(JP_LON,JP_SW)
116!
117      REAL_B    ::     PAPH5(JP_LON,JP_LEVP1)
118      REAL_B    ::      PAP5(JP_LON,JP_LEV)
119!
120      REAL_B    ::    PCCO25
121      REAL_B    ::    PCLFR5(JP_LON,JP_LEV)
122      REAL_B    ::      PDP5(JP_LON,JP_LEV)
123      REAL_B    ::    PEMIS5(JP_LON)
124      REAL_B    ::    PEMIW5(JP_LON)
125      REAL_B    ::     PLSM5(JP_LON)
126      REAL_B    ::     PMU05(JP_LON)
127      REAL_B    ::    POZON5(JP_LON,JP_LEV)
128      REAL_B    ::       PQ5(JP_LON,JP_LEV)
129!
130      REAL_B    ::    PQIWP5(JP_LON,JP_LEV)
131      REAL_B    ::    PQLWP5(JP_LON,JP_LEV)          ! Dropplets    Concentration
132      REAL_B    ::    PSQIW5(JP_LON,JP_LEV)          ! Ice Crystals Concentration
133      REAL_B    ::    PSQLW5(JP_LON,JP_LEV)          !
134      REAL_B    ::      PQS5(JP_LON,JP_LEV)
135      REAL_B    ::   PQRAIN5(JP_LON,JP_LEV)
136      REAL_B    ::   PRAINT5(JP_LON,JP_LEV)
137      REAL_B    ::   PRLVRI5(JP_LON,JP_LEV)
138      REAL_B    ::   PRLVRL5(JP_LON,JP_LEV)
139      REAL_B    ::      PTH5(JP_LON,JP_LEVP1)
140      REAL_B    ::       PT5(JP_LON,JP_LEV)
141      REAL_B    ::      PTS5(JP_LON)
142      REAL_B    ::    PNBAS5(JP_LON)       
143      REAL_B    ::    PNTOP5(JP_LON)
144!
145      REAL_B    ::    PEMIT5(JP_LON)
146      REAL_B    ::     PFCT5(JP_LON,JP_LEVP1)
147      REAL_B    ::     PFLT5(JP_LON,JP_LEVP1)
148      REAL_B    ::     PFCS5(JP_LON,JP_LEVP1)
149      REAL_B    ::     PFLS5(JP_LON,JP_LEVP1)
150      REAL_B    ::   PFRSOD5(JP_LON)
151      REAL_B    ::    PSUDU5(JP_LON)
152      REAL_B    ::    PUVDF5(JP_LON)
153      REAL_B    ::    PPARF5(JP_LON)
154      REAL_B    ::    PFDCT5(JP_LON,JP_LEVP1)
155      REAL_B    ::    PFUCT5(JP_LON,JP_LEVP1)
156      REAL_B    ::    PFDLT5(JP_LON,JP_LEVP1)
157      REAL_B    ::    PFULT5(JP_LON,JP_LEVP1)
158      REAL_B    ::    PFDCS5(JP_LON,JP_LEVP1)
159      REAL_B    ::    PFUCS5(JP_LON,JP_LEVP1)
160      REAL_B    ::    PFDLS5(JP_LON,JP_LEVP1)
161      REAL_B    ::    PFULS5(JP_LON,JP_LEVP1)
162!
163      REAL_B    ::    ZTAU5 (JP_LON,JP_SW,JP_LEV)    ! Cloud Optical Depth
164      REAL_B    ::    ZTAUI5(JP_LON)                 ! Cloud Optical Depth (vert.int.)
165!
166      REAL_B    ::    ASWBOX(JP_LON,100)
167      REAL_B    ::    OLRBOX(JP_LON,100)
168      REAL_B    ::    SLWBOX(JP_LON,100)
169      REAL_B    ::    SSWBOX(JP_LON,100)
170      REAL_B    ::    TAUBOX(JP_LON,100)
171      REAL_B    ::    CLDBOX(JP_LON,100,JP_LEV)
172
173!   For Use in SUCLD
174!   ^^^^^^^^^^^^^^^^
175      REAL_B    ::   ZETAH(JP_LEVP1)
176
177
178
179!  Local  Variables
180!  ----------------
181
182      REAL_B    ::         RTIMTR  , ZTHETOZ , ZANGOZC
183      REAL_B    ::         Zone_t                                       !  Time  Zone                               [hr]
184      REAL_B    ::         qcloud                                       !  Cloud Particles Concentration          [g/kg]
185      REAL_B    ::         fcloud                                       !  Cloud           Fraction                  [%]
186      REAL_B    ::         LWUpwd                                       !  Surface Upward  Longwave Radiation     [W/m2]
187      REAL_B    ::         Emi_Cl                                       !  Cloud Emissivity (diagnostic)             [-]
188
189      INTEGER_M ::    i       , j       , ikl     ,k
190      INTEGER_M ::    JL      , JK      , JAER    ,JNU
191      INTEGER_M ::    KULOUT  , NINDAT  , NSSSSS  ,KPRTLEV
192      INTEGER_M ::    IYR     , MONTH   , IDAY    ,IMINUT
193      INTEGER_M ::    KPRINT  , SKSHIFT
194
195
196
197
198! Load External Functions
199! =======================
200
201#include "fctast.h"
202#include "fcttim.h"
203#include "fcttre.h"
204
205
206      KPRTLEV= 1
207      KPRINT = 1
208      SKSHIFT= 0
209
210
211
212
213! OUTPUT for DEBUGGING
214! ====================
215
216! #DB kio = 1
217! #DB kjo = 1
218
219
220
221
222! Date & Time
223! ===========
224
225      NINDAT = min(yearTU,2004)*10000+mon_TU*100+Day_TU                 ! Date   in the form  yyyyMMdd
226      NSSSSS =     HourTU      * 3600+minuTU* 60+sec_TU                 ! Nb of second since day Begin
227
228! VER   v
229        write(6,*) ' NINDAT: ',NINDAT
230        write(6,*) ' NSSSSS: ',NSSSSS
231! VER   ^
232      IYR    =   NAA(NINDAT)
233      MONTH  =   NMM(NINDAT)
234      IDAY   =   NDD(NINDAT)
235      RTIMTR = RTIME(IYR,MONTH,IDAY,NSSSSS)
236      IMINUT =   INT(FLOAT(NSSSSS)/60.)
237
238
239
240
241! Basic Initialization
242! ====================
243
244!  Dimensions (auxiliary variables)
245!  --------------------------------
246
247        KIDIA  = 1                                   ! DO'NT CHANGE
248        KFDIA  = JP_LON                              ! Nb Columns
249        KTDIA  = 1                                   !
250        KLON   = JP_LON                              ! Nb Columns
251        KLEV   = JP_LEV                              ! Nb Levels
252        KMODE  = JP_MODE                             ! Used in Planck Fcts Specification
253        KAER   = JP_AER                              !
254
255        DO     ikl  = 1 ,  kcolp
256          k2ii(ikl) = ii__AP(ikl)
257          k2jj(ikl) = jj__AP(ikl)
258        ENDDO
259
260!   Nb of Solar Spectral Intervals
261!   ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
262        KSW    =  JP_SW                              ! SW Nb of Spectral Intervals (max is JP_SW=6)
263        NSW    =  JP_SW                              ! SW Nb of Spectral Intervals (max is JP_SW=6)
264        NTSW   =  JP_SW                              ! SW Nb of Spectral Intervals (max is JP_SW=6)
265
266        KBOX   = 0                                   !                                      \VER
267        NBOX   = 1                                   !                                      \VER
268
269        ILWRAD = 1                                   ! 0: Morcrette,     1991 operational before 20000627
270                                                     ! 1: Mlawer et al., 1997 now ECMWF-operational
271                                                     ! 2: Morcrette,     1991 original as in ERA-15'
272
273        NDUMP  = 3                                   ! No Print
274!       NDUMP  = 2                                   ! 1D Results
275!       NDUMP  = 1                                   ! Debug
276!       NDUMP  = 0                                   ! ALL
277        KULOUT = 6                                   ! Output Device for SUCST
278
279
280
281
282! Radiation: Global (Time dependant) Parameters
283! =============================================
284
285        PRII05 = RI0/(dST_UA*dST_UA)                 ! INSOLATION   (dST_UA: Distance Soleil-Terre [UA])
286        PCCO25 = 360.E-06*44./29.                    ! CONCENTRATION IN CO2 (PA/PA)
287
288
289
290
291! Surface Properties
292! ==================
293
294!  Surface Albedo
295!  --------------
296
297  DO jl=1,KLON
298        ikl               = min(jl,kcolp)
299        i                 = ii__AP(ikl)
300        j                 = jj__AP(ikl)
301    DO jnu=1,KSW
302        PALBD5(JL,JNU)    = Alb_SV_gpt(jl)
303        PALBP5(JL,JNU)    = Alb_SV_gpt(jl)
304    ENDDO
305
306!  Surface Emissivity
307!  ------------------
308
309        PEMIS5(JL)        = EmisSV_gpt(jl)
310        PEMIW5(JL)        = EmisSV_gpt(jl)
311
312
313!  Land/sea Mask (1.=land)
314!  -------------
315
316        PLSM5 (JL)    = 1 - MaskSV_gpt(jl)
317
318
319!  Cosine (Solar zenithal Distance)
320!  --------------------------------
321
322        PMU05 (JL)    =     csz_S0(ikl)
323
324
325
326
327! Atmospheric Thermodynamics (Time and Space dependant)
328! =====================================================
329
330!  Pressure
331!  --------
332
333! Martin control
334!PRINT*,'sigma(:)=',sigma(:)
335!PRINT*,'sigmi(:)=',sigmi(:)
336! Martin control
337
338       JK=1+KLEV
339        PAPH5 (JL,JK)     = (psa_DY(ikl)             + pt__DY) * 1000.  ! Pressure (Layer Interface)[Pa]
340    DO JK=1,KLEV
341        PAPH5 (JL,JK)     = (psa_DY(ikl) * sigma(JK) + pt__DY) * 1000.  ! Pressure (Layer)          [Pa]
342        PAP5  (JL,JK)     = (psa_DY(ikl) * sigmi(JK) + pt__DY) * 1000.  ! Pressure (Layer Interface)[Pa]
343        PDP5  (JL,JK)     =  psa_DY(ikl) *dsigmi(JK)           * 1000.  ! Pressure (Layer Thickness)[Pa]
344
345
346!  Water Species      Distributions
347!  --------------------------------
348
349          PQ5    (JL,JK)  = qv__DY(ikl,JK)                              ! Water Vapor  Concentr. [kg/kg]
350        IF      (RTi_qi_and_qs)                                     THEN
351          PQIWP5 (JL,JK)  = qi__CM(ikl,JK)                             &! Ice Crystals Concentr. [kg/kg]
352     &    + (1.-min(1.,exp((Ta__DY(ikl,JK)-258.15)*0.1)))              &! AND
353     &    * (               qs__CM(ikl,JK)        *0.33 )               ! Snow Particl.Concentr. [kg/kg]
354        ELSE                                                            !
355          PQIWP5 (JL,JK)  = qi__CM(ikl,JK)                              ! Ice Crystals Concentr. [kg/kg]
356        END IF
357          PQIWP5 (JL,JK)    = max(0.,PQIWP5(JL, JK)-1.E-9)              ! Ice Crystals Concentr. [kg/kg]
358
359          PQLWP5 (JL,JK)    = max(0.,qw__CM(ikl,JK)-1.E-9)              ! Dropplet     Concentr. [kg/kg]
360
361          PQS5   (JL,JK)    =        qvswCM(ikl,JK)                     ! Saturat. % Water       [kg/kg]
362          PQRAIN5(JL,JK)    =        qr__CM(ikl,JK)                     ! Drops        Concentr. [kg/kg]
363          PRAINT5(JL,JK)    = 0.                                        !                           \VER
364          PRLVRI5(JL,JK)    = 0.                                        ! e-mail J.-J.M. 20031203
365          PSQIW5 (JL,JK)    = 1.                                        !    exp(-PRLVRI5(JL,JK))
366          PRLVRL5(JL,JK)    = 0.                                        ! e-mail J.-J.M. 20031203
367          PSQLW5 (JL,JK)    = 1.                                        !    exp(-PRLVRL5(JL,JK))
368
369
370!  Cloud Fraction
371!  --------------
372
373        IF (CFrCEP)                                                 THEN
374          PCLFR5 (JL,JK)    =       (PQIWP5(JL,JK)+PQLWP5(JL,JK))      &! ECMWF Paramet.
375     &                             /(FraQws       *  PQS5(JL,JK))       !  (VERY Crude)
376          PCLFR5 (JL,JK)    =       min( _ONE_    ,PCLFR5(JL,JK))       !
377          PCLFR5 (JL,JK)    =       max(1.0E-3    ,PCLFR5(JL,JK))      &! no small values
378     &        *max(_ZERO_,sign(_ONE_,PQIWP5(JL,JK)+PQLWP5(JL,JK)       &!
379     &                              -2.E-9_JPRB))                       !
380          CFraCM (ikl,JK)   =        PCLFR5(JL,JK)                      !
381        ELSE
382          PCLFR5 (JL,JK)    =        CFraCM(ikl,JK)                     ! Cloud Fraction from CMiPhy [-]
383        END IF
384!         write(4,4) JL,JK,PQLWP5(JL,JK),PQIWP5(JL,JK)                 &
385!    &                    ,  PQS5(JL,JK)                               &
386!    &                    ,CFraCM(JL,JK),PCLFR5(JL,JK)
387!4        format(2i6,' Cloud Liq.W.= ', f9.6,5x                        &
388!    &              ,' Cloud Sol.W.= ', f9.6,5x                        &
389!    &              ,' Satur.W.Vap.= ', f9.6,5x                        &
390!    &              ,' Cloud Fract.= ',2f9.6)
391
392!  Temperature        Distribution
393!  -------------------------------
394
395          PT5    (JL,JK)    =        Ta__DY(ikl,JK)
396          PTH5   (JL,JK)    = 0.5 * (Ta__DY(ikl,JK)+Ta__DY(ikl,max(1,JK-1)))
397    END DO
398        PTH5   (JL,KLEV+1)  =        Ta__DY(ikl,mzpp)
399        PTS5   (JL)         =        Ta__DY(ikl,mzpp)
400
401
402!  Convective Layer
403!  ----------------
404
405        PNBAS5 (JL)       = 1.                !                                 \VER
406        PNTOP5 (JL)       = 1.                !                                 \VER
407  ENDDO
408
409
410
411
412! Assignation    (Climatologies, Time   dependant)
413! ================================================
414
415!  Aerosols Optical Thickness Horizontal Distribution (model grid
416!  --------------------------------------------------  independant)
417
418!            *******
419        CALL SUECAEC ( NINDAT, IMINUT )     ! TEGEN ET AL. (1997, JGR 102,
420!            *******                        !               pp23895-23915)
421 
422
423!  Aerosols Optical Thickness Vertical   Distribution
424!  --------------------------------------------------
425!            *******
426
427
428! Martin modification for MAR-LMDZ:
429DO jk=1,klev+1
430   ZETAH(jk)=PAPH5(1,jk)/PAPH5(1,klev+1)
431ENDDO
432! Martin Control
433!Print*, 'Dans Atm_RT_RUN:'
434!PRINT*,'ZETAH=',ZETAH
435!PRINT*,'=KLEV',KLEV
436! Martin Control
437
438! Martin Control
439
440        CALL SUAERV                                                  &
441                 & ( KLEV   ,ZETAH                                   &
442                 & , CVDAES ,CVDAEL ,CVDAEU ,CVDAED                  &
443                 & , RCTRBGA,RCVOBGA,RCSTBGA,RCAEOPS,RCAEOPL,RCAEOPU &
444                 & , RCAEOPD,RCTRPT ,RCAEADK,RCAEADM,RCAEROS         &
445                 & )
446!            *******
447
448
449!  O3
450!  --   
451
452!   Fortuin-Langematz O3 climatology
453!   ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
454!            *******
455        CALL SUECOZC ( NINDAT , IMINUT )
456!            *******
457
458!   ECMWF   Geleyn    O3 Climatology
459!   ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
460        ZTHETOZ=RTETA( RTIMTR  )
461        ZANGOZC=  REL( ZTHETOZ ) - 1.7535
462
463!            *******
464        CALL SUECOZO ( ZANGOZC )
465!            *******
466
467
468
469
470! Interpolation on the MAR Grid
471! =============================
472
473        DO JL=1,KLON
474          ikl=min(JL,kcolp)
475          PGELAM5(JL)=    lon__r(ikl)
476           PGEMU5(JL)=SIN(lat__r(ikl))
477           PCLON5(JL)=COS(lon__r(ikl))
478           PSLON5(JL)=SIN(lon__r(ikl))
479        END DO
480
481!              ******
482         CALL  RADACA                                       &
483          &( KIDIA , KLON   , KLON  , KTDIA , KLEV          &
484          &, PAPH5 , PGELAM5, PGEMU5, PCLON5, PSLON5, PTH5  &
485          &, ZAER5 , ZOZON5                                 &
486          &  )
487!              ******
488
489
490!  OLD         ECMWF O3 Climatology
491!  --------------------------------
492
493        IF (NOZOCL.EQ.1 .OR. NOZOCL.EQ.3)                           THEN
494          DO JK=1,KLEV
495            DO JL=KIDIA,KFDIA
496              POZON5(JL,JK)      = ZOZON5(JL,JK)
497            ENDDO
498          ENDDO
499        END IF
500
501
502!  FORTUIN LANGEMATZ O3 Climatology
503!  --------------------------------
504
505        IF (NOZOCL.EQ.2 .OR. NOZOCL.EQ.4)                           THEN
506
507!              ******
508          CALL RADOZC ( KIDIA ,KLON  , KLON   , KTDIA, KLEV            &
509                     &, KPRINT,KLON  , SKSHIFT, PAPH5, PGEMU5, ZOZON5)
510!              ******
511
512          DO JK=1,KLEV
513            DO JL=KIDIA,KFDIA
514              POZON5(JL,JK)      = ZOZON5(JL,JK)
515            ENDDO
516          ENDDO
517 
518        END IF
519
520
521!  AEROSOLS
522!  --------
523
524        IF (NOZOCL.EQ.1 .OR. NOZOCL.EQ.2)                           THEN
525          DO jk=1,klev
526            DO jaer=1,KAER
527              DO jl=KIDIA,KFDIA
528                PAER5(JL,JAER,JK)= ZAER5(JL,JAER,JK)
529              ENDDO
530            ENDDO
531          ENDDO
532        END IF
533
534
535!  NO AEROSOLS
536!  -----------
537
538        IF (NOZOCL.GT.2)                                            THEN
539          DO jk=1,klev
540            DO jaer=1,KAER
541              DO jl=KIDIA,KFDIA
542                PAER5(JL,JAER,JK)= ZEPAER
543              ENDDO
544            ENDDO
545          ENDDO
546        END IF
547
548
549!  SECURITY CHECK ON AEROSOL AMOUNTS
550!  ---------------------------------
551
552        DO JK=1,KLEV
553          DO JAER=1,KAER
554            DO JL=KIDIA,KFDIA
555              PAER5(JL,JAER,JK)=MAX(ZEPAER,PAER5(JL,JAER,JK))
556            ENDDO
557          ENDDO
558        ENDDO
559
560
561
562
563! Transmission to MAR Variables
564! =============================
565
566      DO JL=1,KLON
567              ikl=min(JL,kcolp)
568
569        DO JK=1,KLEV
570              O3__RT(ikl,jk     ) = ZOZON5(JL,JK)                       ! O3      Concentr.
571        END DO
572
573        DO JK=1,KLEV
574          DO JAER=1,KAER
575              AersRT(ikl,jk,jaer) =  PAER5(JL,JAER,JK)                  ! Aerosol Optical Thickness
576          END DO
577        END DO
578
579      END DO
580
581
582
583
584! Solar and IR Transfer through the Atmosphere
585! ============================================
586
587
588! VER   v
589!       STOP 'Fin momentanee'
590! VER   ^
591!                ******
592            CALL RADLSW                                                 &
593     &    ( KIDIA , KFDIA , KLON  , KTDIA , KLEV   , KMODE , KAER,      &
594     &      KBOX  , NBOX                                                &
595     &    , NDUMP , ILWRAD                                              &
596     &    , PRII05                                                      &
597     &    , PAER5 , PALBD5, PALBP5, PAPH5 , PAP5                        &
598     &    , PCCO25, PCLFR5, PDP5  , PEMIS5, PEMIW5 , PLSM5 ,  PMU05,    &
599     &      POZON5                                                      &
600     &    , PQ5   , PQIWP5, PQLWP5, PSQIW5, PSQLW5 , PQS5  ,  PQRAIN5,  &
601     &      PRAINT5                                                     &
602     &    , PRLVRI5,PRLVRL5,PTH5  , PT5   , PTS5   , PNBAS5,  PNTOP5    &
603     &    , PEMIT5, PFCT5 , PFLT5 , PFCS5 , PFLS5  , PFRSOD5, PSUDU5,   &
604     &      PUVDF5, PPARF5                                              &
605     &    , PFDCT5, PFUCT5, PFDLT5, PFULT5, PFDCS5 , PFUCS5,  PFDLS5,   &
606     &      PFULS5                                                      &
607     &    , ZTAU5 , ZTAUI5                                              &
608     &    , ASWBOX, OLRBOX, SLWBOX, SSWBOX, TAUBOX , CLDBOX             &
609! #DB&                                                     ,  k2ii,k2jj &
610     &    )
611!                ******
612
613
614
615
616! Radiative Fluxes   Distributions
617! ================================
618
619  DO JL=1,KLON
620        ikl = min(JL,kcolp)
621    DO JK=1,KLEV+1
622        FIRn_c (ikl,jk)    = PFCT5 (JL,JK)                              ! CLEAR-SKY LW NET FLUXES [W/m2]
623        FIRn_t (ikl,jk)    = PFLT5 (JL,JK)                              ! TOTAL-SKY LW NET FLUXES [W/m2]
624        FSOn_c (ikl,jk)    = PFCS5 (JL,JK)                              ! CLEAR-SKY SW NET FLUXES [W/m2]
625        FSOn_t (ikl,jk)    = PFLS5 (JL,JK)                              ! TOTAL-SKY SW NET FLUXES [W/m2]
626    END DO
627
628
629
630
631! Cloud Optical Depth
632! ===================
633
634    DO JK=1,KLEV
635        kj              =  KLEV + 1    -JK                              !
636        ODCzRT (ikl,kj) =  ZTAU5(JL,  1,JK)                             ! Cloud Optical Depth
637       DO nAe=1,naero                                                   !
638        ODAzRT (ikl,jk) = ODAzRT(ikl,jk   ) + PAER5(JL,nAe,JK)          ! Aeros.Optical Depth
639       END DO                                                           !
640    END DO                                                              !
641                                                                        !
642        ODC_RT (ikl   ) = ZTAUI5(JL)                                    ! Cloud Optical Depth (vert.integr.,
643                                                                        !                      1st interval)
644        ODA_RT (ikl   ) = 0.                                            !
645    DO JK=1,KLEV                                                        !
646        ODA_RT (ikl   ) = ODA_RT(ikl)       + ODAzRT(ikl,jk)            ! Aeros.Optical Depth
647    END DO
648
649
650
651
652! SURFACE RADIATIVE CHARACTERISTICS (SW)
653! ======================================
654
655        FSOs_t(ikl)     = PFRSOD5(JL)                                   ! TOTAL-SKY SRF SW DOWNWARD FLUX    [W/m2]
656        FSOdir(ikl)     =  PSUDU5(JL)                                   ! SOLAR RADIANCE IN SUN'S DIRECT.   [W/m2]
657        FSOsUV(ikl)     =  PUVDF5(JL)                                   ! SURFAC.DOWNWARD U.V. RADIATION    [W/m2]
658        FSOeff(ikl)     =  PPARF5(JL)                                   ! PHOTOSYNTHET. ACTIVE RADIATION    [W/m2]
659
660
661
662
663! SURFACE RADIATIVE CHARACTERISTICS (LW)
664! ======================================
665!       EmisSV_gpt(jl ) =  PEMIT5(JL)                                   ! TOTAL LW EMISSIVITY                \VER
666
667  END DO
668
669
670
671
672!  Grid  Point   Dependant Variables <-- Atm_RT "Vector"Variables
673!  ==============================================================
674
675        DO   ikl = 1,kcolp
676
677              i =  ii__AP(ikl)
678              j =  jj__AP(ikl)
679
680!  OutgoingLongWave Radiation Fluxes
681!  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
682              OLR_RT    (ikl)   =-FIRn_t(ikl,1   )                                            ! Atm Top LongWave Heat Flux (+)  (  Upward)
683
684!  Surface Downward Radiative Fluxes
685!  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
686              SWDsRT    (ikl)   = FSOs_t(ikl     )                                            ! Surface ShrtWave Heat Flux (+)  (Downward)
687              SWAsRT    (ikl)   = FSOs_t(ikl     )*(1.-Alb_SV_gpt(ikl))                       ! Surface ShrtWave Heat Flux (+)  (Absorbed)
688              LWDsRT    (ikl)   = FIRn_t(ikl,mzpp)                                           &!
689     &                          + Ta__DY(ikl,mzpp)*    Ta__DY(ikl,mzpp)                      &!
690     &                           *Ta__DY(ikl,mzpp)*    Ta__DY(ikl,mzpp)                      &!
691     &                           *StefBo          *    EmisSV_gpt(ikl)                        !
692
693!  Cloud   Fraction
694!  ^^^^^^^^^^^^^^^^
695              ClouRT    (ikl)   =  0.0
696          DO  k  = 1,mzp
697              ClouRT    (ikl)   =  max(CFraCM(ikl,k)   , ClouRT(ikl))
698
699!  Radiative Heating
700!  ^^^^^^^^^^^^^^^^^
701              LWdTRT    (ikl,k) =  - ( FIRn_t(ikl,k+1) - FIRn_t(ikl,k) )                     &!
702     &                  *  Grav_F  / ( CpdAir *1.e3 *psa_DY(ikl) *dsigmi(k))                  !
703              SWdTRT    (ikl,k) =  - ( FSOn_t(ikl,k+1) - FSOn_t(ikl,k) )                     &!
704     &                  *  Grav_F  / ( CpdAir *1.e3 *psa_DY(ikl) *dsigmi(k))                  !
705
706              dpktRT    (ikl,k) =    ( LWdTRT(ikl,k) + SWdTRT(ikl,k) ) / ExnrDY(ikl,k)
707              LWdTRT    (ikl,k) =      LWdTRT(ikl,k) * 86400.
708              SWdTRT    (ikl,k) =      SWdTRT(ikl,k) * 86400.
709
710          END DO
711
712        END DO
713
714
715
716
717
718! OUTPUT
719! ======
720
721! OUTPUT for Analysis
722! -------------------
723
724      IF          (iklOUT.GT.0)                                     THEN
725
726        ikl =      iklOUT
727        i = ii__AP(iklOUT)
728        j = jj__AP(iklOUT)
729        Zone_t = lon__h(ikl) - 12.
730
731            write(4,401)Day_TU,Mon_TU,HourTU       ,minuTU,            &
732     &                                Zone_t       , i ,j
733  401       format(//,' +-- Radiative  Heat Fluxes --+',               &
734     &       i4,'/',i2,i4,':',i2,' h.LT (',f4.0')',                    &
735     &                '  (i,j) = (',i3,',',i3,')',                     &
736     &        //,' | Altitud | Pressur.| Temper.|  Ozone  | W.Vapor|', &
737     &      ' Clouds | Clouds |  Opt.D | Aer.OD. | So Warm.|',         &
738     &       ' Emiss.| IR Cool.| IR NetF.|',                           &
739     &         /,' |   [km]  |   [hPa] |   [K]  | [cmSTP] | [g/kg] |', &
740     &      ' [g/kg] |   [%]  |   [-]  |   [-]   | [K/day] |',         &
741     &       '  [-]  | [K/day] |  [W/m2] |',                           &
742     &         /,' +---------+---------+--------+---------+--------+', &
743     &              '--------+--------+--------+---------+---------+', &
744     &       '-------+---------+---------+')
745
746            write(4,404)                           pt__DY*1.e+1        &
747     &           ,                                 OLR_RT(ikl)
748  404       format(                                                    &
749     &                     ' |  SOMMET |',f8.2,' |', 7x ,' |', 8x ,' |'&
750     &        , 3( 7x ,' |'),    7x ,' |', 8x ,' |', 8x ,' |'          &
751     &        ,                            6x ,' |', 8x ,' |',f8.1,' |'&
752     &        ,/,' +---------+---------+--------+---------+--------+', &
753     &              '--------+--------+--------+---------+---------+', &
754     &       '-------+---------+---------+')
755
756
757            DO k =1,mzp
758
759               qcloud = 1.e+3 *(qw__CM(ikl,k)+qi__CM(ikl,k))
760               fcloud = 1.e+2 * CFraCM(ikl,k)
761               Emi_Cl = 1.-exp(-qcloud *0.5 *(Z___DY(ikl,max(1,k-1))-Z___DY(ikl,k+1))  &
762     &                            * sigma(k)* psa_DY(ikl) /    (287.*Ta__DY(ikl,k  )))
763
764               write(4,402)    1.e-3*Z___DY(ikl,k),PAP5  (ikl,k)*1.e-2 &
765     &           ,Ta__DY(ikl,k)     ,O3__RT(ikl,k)                     &
766     &           ,qv__DY(ikl,k)*1.e3,qcloud       ,fcloud              &
767     &           ,ODCzRT(ikl,k)     ,ODAzRT(ikl,k),SWdTRT(ikl,k)       &
768     &           ,Emi_Cl                          ,LWdTRT(ikl,k)       &
769     &                                            ,FIRn_t(ikl,k)
770  402          format(' | ',  f7.3,' |' ,f8.2,' |',f7.2,' |',e8.2,' |',&
771     &         2(f7.3,' |'),2(f7.2,' |'),e8.2,' |',f8.4,' |'           &
772     &          ,                         f6.3,' |',f8.2,' |',f8.1,' |')
773
774            END DO
775
776
777               LWUpwd =          Ta__DY(ikl,mzpp)*    Ta__DY(ikl,mzpp) &!
778     &                          *Ta__DY(ikl,mzpp)*    Ta__DY(ikl,mzpp) &!
779     &                          *StefBo          *    EmisSV_gpt( ikl)  !
780
781            write(4,403)                     1.e+1*psa_DY(ikl)         &
782     &           ,Ta__DY(ikl,mzpp)                                     &
783     &           ,ODC_RT(ikl     )  ,ODA_RT(  ikl),FSOs_t(ikl)         &
784     &                                            ,FIRn_t(ikl,mzpp)    &
785     &                            ,Alb_SV_gpt(ikl),SWAsRT(ikl)         &
786     &                            ,EmisSV_gpt(ikl),LWDsRT(ikl)         &
787     &                             ,LWUpwd
788  403       format(                                                    &
789     &           ' +---------+---------+--------+---------+--------+', &
790     &              '--------+--------+--------+---------+---------+', &
791     &       '-------+---------+---------+',                           &
792     &                   /,' | AIR-SOL |',f8.2,' |',f7.2,' |', 8x ,' |'&
793     &        , 3( 7x ,' |'),   f7.2,' |',e8.2,' |',f8.1,' |'          &
794     &        ,                            6x ,' |', 8x ,' |',f8.1,' |'&
795     &        ,          /,' |     SOL |', 8x ,' |', 7x ,' |', 8x ,' |'&
796     &        , 3( 7x ,' |'),    7x ,' |',f8.2,' |',f8.1,' |'          &
797     &        ,                           f6.3,' |',f8.1,' |',f8.1,' |')
798
799      END IF !    (iklOUT.GT.0)
800
801
802! OUTPUT for Debugging
803! --------------------
804
805! #DB     jkjllw=0
806! #DB DO JL=1,KLON
807! #DB     lijio =0
808! #DB     ikl   = min(JL,kcolp)
809! #DB DO JK=1,KLEV
810!!      write(6,*) k2ii(JL),k2jj(JL),jl,jk,' FIRn_t: ', PFLT5(jl,jk)
811!!      write(6,*) k2ii(JL),k2jj(JL),jl,jk,' FSOn_t: ', PFLS5(jl,jk)
812! #DB   IF ( PFLT5(jl,jk).GT. 500..OR. PFLS5(jl,jk).GT. 500. .OR.              &
813! #DB&       PFLT5(jl,jk).LT.-500..OR. PFLS5(jl,jk).LT.-500. .OR.              &
814! #DB&       (k2ii(jl).EQ.kio.AND.k2jj(jl).EQ.kjo)) lijio=1
815! #DB END DO
816! #DB IF   (lijio.EQ.1)                                             THEN
817! #DB   DO JK=1,KLEV
818! #DB     IF (mod(jkjllw,20).EQ.0)                                             &
819! #DB&        write(6,600)
820! #DB     600 format('IN   PHYrad2CEP: Radiative Fluxes ',/                    &
821! #DB&              ,'    i    j   JL   JK',9x,'Ta',9x,'Qv',9x,'Qi',9x,'Qw'    &
822! #DB&              ,9x,'O3',8x,'CLD',8x,'COD',8x,'AOD',8x,'SOn',8x,'IRn')
823! #DB         jkjllw=jkjllw+1
824! #DB         write(6,601) k2ii(JL),k2jj(JL),JL,JK                             &
825! #DB&                ,Ta__DY(ikl,JK),PQ5   (jk,jl)                            &
826! #DB&                ,PQIWP5(JL,JK) ,PQLWP5(JL,JK)                            &
827! #DB&                ,O3__RT(ikl,jk),CFraCM(ikl,JK)                           &
828! #DB&                ,ODCzRT(ikl,jk),ODAzRT(ikl,jk)                           &
829! #DB&                ,FSOn_t(ikl,jk),FIRn_t(ikl,jk)
830! #DB     601  format(4i5,10e11.3)
831! #DB   END DO
832! #DB ENDIF
833!
834! #DB END DO
835
836
837
838
839      return
840      end subroutine Atm_RT_RUN
Note: See TracBrowser for help on using the repository browser.