source: trunk/LMDZ.MARS/libf/phymars/lwtt.F @ 2156

Last change on this file since 2156 was 1266, checked in by aslmd, 11 years ago

LMDZ.MARS
IMPORTANT CHANGE

  • Remove all reference/use of nlayermx and dimphys.h
  • Made use of automatic arrays whenever arrays are needed with dimension nlayer
  • Remove lots of obsolete reference to dimensions.h
  • Converted iono.h and param_v4.h into corresponding modules

(with embedded subroutine to allocate arrays)
(no arrays allocated if thermosphere not used)

  • Deleted param.h and put contents into module param_v4_h
  • Adapted testphys1d, newstart, etc...
  • Made DATA arrays in param_read to be initialized by subroutine

fill_data_thermos in module param_v4_h

  • Optimized computations in paramfoto_compact (twice less dlog10 calculations)
  • Checked consistency before/after modification in debug mode
  • Checked performance is not impacted (same as before)
File size: 2.2 KB
RevLine 
[38]1      subroutine lwtt (kdlon,u,up,nu,tr)
2
3c----------------------------------------------------------------------
4c     LWTT   computes the longwave transmission functions
5c            for all the absorbers in all spectral intervals
6c            using pade approximants and horner's algorithm
7c----------------------------------------------------------------------
8
[1047]9      use dimradmars_mod, only : ndlon, ndlo2
10      use yomlw_h, only: ga, gb, cst_voigt
[38]11      implicit none
12
13c----------------------------------------------------------------------
14c         0.1   arguments
15c               ---------
16c                                                            inputs:
17c                                                            -------
18      integer kdlon            ! part of ngrid
19      integer nu               !
20
21      real    u (ndlo2,nu)     ! absorber amounts
22      real    up (ndlo2,nu)    ! idem scaled by the pressure
23
24c                                                            outputs:
25c                                                            --------
26      real    tr (ndlo2,nu)    ! transmission functions
27
28c----------------------------------------------------------------------
29c         0.2   local arrays
30c               ------------
31
32      integer ja,jl
33
34      real xn (ndlon)
35      real xd (ndlon)
36      real ueq (ndlon)
37
38c----------------------------------------------------------------------
39c   Transmission by the CO2 15 microns band:
40c   ----------------------------------------
41
42      do  ja=1,nu
43            do jl=1,kdlon
44c                              equivalent absorber amount (Doppler effect)
45c                             --------------------------------------------
46              ueq(jl) = sqrt(up(jl,ja))
47     .              +cst_voigt(1,ja)*u(jl,ja)**cst_voigt(2,ja)
48
49c                                                      Horner's algorithm
50c                                                      ------------------
51            xn(jl) = ga(1,ja) +
52     .      ueq(jl)*(ga(2,ja) + ueq(jl) * ga(3,ja) )
53            xd(jl) = gb(1,ja) + ueq(jl)*(gb(2,ja) +
54     .      ueq(jl) * ( gb(3,ja) + ueq(jl)  ))
55            tr(jl,ja) = xn(jl) / xd(jl)
56
57            enddo
58      enddo
59
60c----------------------------------------------------------------------
61      return
62      end
Note: See TracBrowser for help on using the repository browser.