source: trunk/LMDZ.MARS/libf/aeronomars/thermosphere.F @ 1005

Last change on this file since 1005 was 658, checked in by emillour, 14 years ago

Mars GCM:

  • updated high atmosphere photochemistry (jthermcalc.F, param_v4.h, iono.h, paramfoto_compact.F, param_read.F , thermosphere.F).
  • minor change in calchim.F90 (to not use maxloc(zycol, dim = 2) function which seems to be a problem for g95) .
  • minor bug fix in perosat.F; set tendency on pdqscloud for h2o2 to zero if none is computed.
  • in "moldiff.F", changed "tridag" to "tridag_sp", "LUBKSB" to "LUBKSB_SP" and "LUDCMP" to "LUDCMP_SP" to avoid possible conflicts with same routines defined in "moldiff_red.F". Added use of automatic-sized array in "tridag" and "tridag_sp" local array "gam" (to avoid using an a priori oversized local array).

FGG+JYC+EM
File size: 2.4 KB
Line 
1      subroutine thermosphere(pplev,pplay,dist_sol,
2     $     mu0,ptimestep,ptime,zday,tsurf,zzlev,zzlay,
3     &     pt,pq,pu,pv,pdt,pdq,
4     $     zdteuv,zdtconduc,zdumolvis,zdvmolvis,zdqmoldiff)
5
6      implicit none
7
8#include "dimensions.h"
9#include "dimphys.h"
10#include "comcstfi.h"
11#include "callkeys.h"
12#include "comdiurn.h"
13#include "param.h"
14#include "param_v4.h"
15#include "chimiedata.h"
16#include "conc.h"
17
18
19      INTEGER l,ig
20
21      REAL pplay(ngridmx,nlayermx)
22      real pplev(ngridmx,nlayermx+1)
23      REAL zzlay(ngridmx,nlayermx)
24      real zzlev(ngridmx,nlayermx+1)
25      REAL pt(ngridmx,nlayermx)
26      real zday
27      REAL dist_sol
28      real mu0(ngridmx)
29      real pq(ngridmx,nlayermx,nqmx)
30      real ptimestep
31      real ptime
32      real tsurf(ngridmx)
33      REAL pu(ngridmx,nlayermx),pv(ngridmx,nlayermx)
34      REAL pdt(ngridmx,nlayermx),pdq(ngridmx,nlayermx,nqmx)
35
36      REAL zdteuv(ngridmx,nlayermx)
37      REAL zdtconduc(ngridmx,nlayermx)
38      REAL zdumolvis(ngridmx,nlayermx)
39      REAL zdvmolvis(ngridmx,nlayermx)
40      real zdqmoldiff(ngridmx,nlayermx,nqmx)
41
42      logical firstcall
43      save firstcall
44      data firstcall /.true./
45
46      if (firstcall) then
47        if (.not. tracer) then
48          do l=1,nlayermx
49            do ig=1,ngridmx
50              rnew(ig,l)=r
51              cpnew(ig,l)=cpp
52            enddo
53          enddo
54        endif
55        firstcall= .false.
56      endif
57
58      if (calleuv) then
59        call zerophys(ngridmx*nlayermx,zdteuv)
60        call euvheat(pt,pdt,pplev,pplay,zzlay,
61     $               mu0,ptimestep,ptime,zday,pq,pdq,zdteuv)
62      endif
63
64      if (callconduct) THEN
65        call zerophys(ngridmx*nlayermx,zdtconduc)
66        call conduction(ptimestep,pplay,pplev,pt,zdteuv,
67     $                   tsurf,zzlev,zzlay,zdtconduc)
68      endif
69
70      if (callmolvis) THEN
71        call zerophys(ngridmx*nlayermx,zdumolvis)
72        call molvis(ptimestep,pplay,pplev,pt,zdteuv,zdtconduc,pu,
73     $                   tsurf,zzlev,zzlay,zdumolvis)
74        call zerophys(ngridmx*nlayermx,zdvmolvis)
75        call molvis(ptimestep,pplay,pplev,pt,zdteuv,zdtconduc,pv,
76     $                   tsurf,zzlev,zzlay,zdvmolvis)
77      endif
78
79      if (callmoldiff) THEN
80        call zerophys(ngridmx*nlayermx*nqmx,zdqmoldiff)
81        call moldiff_red(pplay,pplev,pt,pdt,pq,pdq,ptimestep,
82     &                   zzlay,zdteuv,zdtconduc,zdqmoldiff)
83      endif
84
85      return
86      end
87
88
Note: See TracBrowser for help on using the repository browser.