source: trunk/LMDZ.MARS/libf/phymars/lwxb.F @ 1242

Last change on this file since 1242 was 1047, checked in by emillour, 11 years ago

Mars GCM:

  • IMPORTANT CHANGE: Removed all reference/use of ngridmx (dimphys.h) in routines (necessary prerequisite to using parallel dynamics); in most cases this just means adding 'ngrid' as routine argument, and making local saved variables allocatable (and allocated at first call). In the process, had to convert many *.h files to equivalent modules: yomaer.h => yomaer_h.F90 , surfdat.h => surfdat_h.F90 , comsaison.h => comsaison_h.F90 , yomlw.h => yomlw_h.F90 , comdiurn.h => comdiurn_h.F90 , dimradmars.h => dimradmars_mod.F90 , comgeomfi.h => comgeomfi_h.F90, comsoil.h => comsoil_h.F90 , slope.h => slope_mod.F90
  • Also updated EOF routines, everything is now in eofdump_mod.F90
  • Removed unused routine lectfux.F (in dyn3d)

EM
File size: 7.6 KB
RevLine 
[38]1      subroutine lwxb (ig0,kdlon,kflev
2     .                ,emis
3     .                ,aer_t,co2_u,co2_up)
4
5c----------------------------------------------------------------------
6c     LWXB   computes transmission function and exchange coefficients
7c                          for boundaries
8c                          (co2 / aerosols)
9c                       (bands 1 and 2 of co2)
10c----------------------------------------------------------------------
11c
12c              |---|---|---|---|---|---|---|---|
13c   kflev+1    |***|***|***|***|***|***|***| 0 |  (space)
14c              |---|---|---|---|---|---|---|---|
15c    kflev     |***|   |   |   |   |   | 0 |***|
16c              |---|---|---|---|---|---|---|---|
17c     ...      |***|   |   |   |   | 0 |   |***|
18c              |---|---|---|---|---|---|---|---|
19c      4       |***|   |   |   | 0 |   |   |***|
20c              |---|---|---|---|---|---|---|---|
21c      3       |***|   |   | 0 |   |   |   |***|
22c              |---|---|---|---|---|---|---|---|
23c      2       |***|   | 0 |   |   |   |   |***|
24c              |---|---|---|---|---|---|---|---|
25c      1       |***| 0 |   |   |   |   |   |***|
26c              |---|---|---|---|---|---|---|---|
27c      0       | 0 |***|***|***|***|***|***|***|  (ground)
28c              |---|---|---|---|---|---|---|---|
29c                0   1   2   3   4  ...  k |k+1
30c             (ground)                    (space)
31c
32c  (*)  xi computed in this subroutine
33c----------------------------------------------------------------------
34
[1047]35      use dimradmars_mod, only: ndlo2, nuco2, ndlon, nflev
36      use yomlw_h, only: xi, nlaylte
[38]37      implicit none
38
[1047]39!#include "dimensions.h"
40!#include "dimphys.h"
41!#include "dimradmars.h"
42!#include "callkeys.h"
[38]43 
[1047]44!#include "yomlw.h"
[38]45
46c----------------------------------------------------------------------
47c         0.1   arguments
48c               ---------
49c                                                            inputs:
50c                                                            -------
51      integer kdlon          ! part of ngrid
52      integer kflev          ! part of nalyer
53
54      real emis (ndlo2)                  ! surface emissivity
55      real aer_t (ndlo2,nuco2,kflev+1)   ! transmission (aer)
56      real co2_u (ndlo2,nuco2,kflev+1)   ! absorber amounts (co2)
57      real co2_up (ndlo2,nuco2,kflev+1)  ! idem scaled by the pressure (co2)
58
59c----------------------------------------------------------------------
60c         0.2   local arrays
61c               ------------
62
63      integer ja,jl,jk,ig0
64
65      real zt_co2 (ndlon,nuco2)
66      real zt_aer (ndlon,nuco2)
67      real zu (ndlon,nuco2)
68      real zup (ndlon,nuco2)
69c                                          2 for ground(1) and space(2)
70      real trans (ndlon,nuco2,2,0:nflev+1)
71      real ksi (ndlon,nuco2,2,0:nflev+1)
72c                                                       only for space
73      real trans_emis (ndlon,nuco2,0:nflev+1)
74      real ksi_emis (ndlon,nuco2,0:nflev+1)
75
76c*************************************************************************
77c         1.0   Transmissions
78c               -------------
79c----------------------------------------------------------------------
80c         1.1   Direct Transmission
81c               -------------------
82
83c                                                                 space
84c                                                                 -----
85      do jk = 1 , nlaylte+1
86
87        do ja = 1 , nuco2
88          do jl = 1 , kdlon
89            zu(jl,ja)  = co2_u(jl,ja,jk)
90            zup(jl,ja) = co2_up(jl,ja,jk)
91            zt_aer(jl,ja) = aer_t(jl,ja,jk)
92          enddo
93        enddo
94
95        call lwtt(kdlon,zu,zup,nuco2,zt_co2)
96
97        do ja = 1 , nuco2
98          do jl = 1 , kdlon
99            trans(jl,ja,2,jk)=zt_co2(jl,ja)*zt_aer(jl,ja)
100          enddo
101        enddo
102
103      enddo
104c                                                                 ground
105c                                                                 -----
106      do jk = 1 , nlaylte+1
107
108        do ja = 1 , nuco2
109          do jl = 1 , kdlon
110            zu(jl,ja) =  co2_u(jl,ja,1)  - co2_u(jl,ja,jk)
111            zup(jl,ja) = co2_up(jl,ja,1) - co2_up(jl,ja,jk)
112            zt_aer(jl,ja) = aer_t(jl,ja,1) /aer_t(jl,ja,jk)
113          enddo
114        enddo
115
116        call lwtt(kdlon,zu,zup,nuco2,zt_co2)
117
118        do ja = 1 , nuco2
119          do jl = 1 , kdlon
120            trans(jl,ja,1,jk)=zt_co2(jl,ja)*zt_aer(jl,ja)
121          enddo
122        enddo
123
124      enddo
125
126c----------------------------------------------------------------------
127c         1.2   Transmission with reflexion
128c               ---------------------------
129
130c                                                                 space
131c                                                                 -----
132      do jk = 1 , nlaylte+1
133
134        do ja = 1 , nuco2
135          do jl = 1 , kdlon
136
137            zu(jl,ja) =   2 * co2_u(jl,ja,1)  - co2_u(jl,ja,jk)
138            zup(jl,ja) =  2 * co2_up(jl,ja,1) - co2_up(jl,ja,jk)
139            zt_aer(jl,ja) = aer_t(jl,ja,1)
140     .                    * aer_t(jl,ja,1)
141     .                    / aer_t(jl,ja,jk)
142
143          enddo
144        enddo
145
146        call lwtt(kdlon,zu,zup,nuco2,zt_co2)
147
148        do ja = 1 , nuco2
149          do jl = 1 , kdlon
150            trans_emis(jl,ja,jk)=zt_co2(jl,ja)*zt_aer(jl,ja)
151          enddo
152        enddo
153
154      enddo
155
156c*************************************************************************
157c         2.0   Exchange Coefficiants
158c               ---------------------
159
160      do jk = 1 , nlaylte
161        do ja = 1 , nuco2
162          do jl = 1 , kdlon
163
164c-------------------------------------------------------------------------
165c        2.1    colling to space  (from layer 1,nlaylte toward "layer" nlaylte+1)
166c               ----------------
167
168
169      ksi(jl,ja,2,jk) = trans(jl,ja,2,jk+1)
170     .                - trans(jl,ja,2,jk)
171
172      ksi_emis(jl,ja,jk) = trans_emis(jl,ja,jk)
173     .                   - trans_emis(jl,ja,jk+1)
174
175      xi(ig0+jl,ja,jk,nlaylte+1)= ksi(jl,ja,2,jk)
176     .                        + ksi_emis(jl,ja,jk)* (1 - emis(jl))
177
178c                                                         ksi Reciprocity
179c                                                         ---------------
180      xi(ig0+jl,ja,nlaylte+1,jk)      = xi(ig0+jl,ja,jk,nlaylte+1)
181
182c-------------------------------------------------------------------------
183c        2.2    echange with ground  (from "layer" 0 toward layers 1,nlaylte)
184c               -------------------
185
186
187      ksi(jl,ja,1,jk) = trans(jl,ja,1,jk)
188     .                - trans(jl,ja,1,jk+1)
189
190      xi(ig0+jl,ja,0,jk) = ksi(jl,ja,1,jk) * emis(jl)
191
192c                                                         ksi Reciprocity
193c                                                         ---------------
194      xi(ig0+jl,ja,jk,0) = xi(ig0+jl,ja,0,jk)
195
196c-------------------------------------------------------------------------
197          enddo
198        enddo
199      enddo
200
201c-------------------------------------------------------------------------
202c       2.3     echange ground-space  (from "layer" 0 toward "layer" nlaylte+1)
203c               ----------------------
204
205c Is not used because we use sigma T4 for the ground budget in physiq.F
206
207      do ja = 1 , nuco2
208        do jl = 1 , kdlon
209
210      ksi(jl,ja,1,nlaylte+1) = trans(jl,ja,1,nlaylte+1)
211      xi(ig0+jl,ja,0,nlaylte+1) = ksi(jl,ja,1,nlaylte+1) * emis(jl)
212
213c                                                         ksi Reciprocity
214c                                                         ---------------
215      xi(ig0+jl,ja,nlaylte+1,0) = xi(ig0+jl,ja,0,nlaylte+1)
216
217        enddo
218      enddo
219
220c-------------------------------------------------------------------------
221      return
222      end
Note: See TracBrowser for help on using the repository browser.