source: trunk/LMDZ.COMMON/libf/dyn3dpar/cpdet.F @ 847

Last change on this file since 847 was 847, checked in by aslmd, 12 years ago

LMDZ.COMMON. Corrected bugs with using variable cp in parallel. Corrected bugs related to problems when no tracers are used. Updated makelmdz_fcm with the latest version and added a few lines necessary for generic physics. Added a build_gcm script in csh. Updated AMD64_CICLAD compilation settings. Uploaded arch files to make the model work with ifort on ciclad.

File size: 6.1 KB
RevLine 
[8]1! ADAPTATION GCM POUR CP(T)
2c======================================================================
3c S. Lebonnois, 10/2010
4c
5c Cp doit être calculé par cpdet(t) pour être valable partout
6c
7c La fonction d'Exner reste pk = RCPD*(play/pref)**RKAPPA
8c (RCPD=cpp, RKAPPA=kappa)
9c
10c On passe de T a teta (temperature potentielle) par t2tpot(t,teta,pk)
11c On passe de teta a T par tpot2t(teta,t,pk)
12c
13c======================================================================
14
15      SUBROUTINE ini_cpdet
[37]16     
17      USE control_mod, ONLY: planet_type
[8]18      IMPLICIT none
19c======================================================================
20c Initialisation de nu_venus et t0_venus
21c======================================================================
22
23! for cpp, nu_venus and t0_venus:
24#include "comconst.h"
25
26      if (planet_type.eq."venus") then
27          nu_venus=0.35
28          t0_venus=460.
29      else
30          nu_venus=0.
31          t0_venus=0.
32      endif
33
34      return
35      end
36
37c======================================================================
38c======================================================================
39
40      FUNCTION cpdet(t)
[37]41
42      USE control_mod, ONLY: planet_type
[8]43      IMPLICIT none
44
45! for cpp, nu_venus and t0_venus:
46#include "comconst.h"
47
48      real cpdet,t
49
50      if (planet_type.eq."venus") then
51          cpdet = cpp*(t/t0_venus)**nu_venus
52      else
53          cpdet = cpp
54      endif
55
56      return
57      end
58     
59c======================================================================
60c======================================================================
61
62      SUBROUTINE t2tpot(npoints, yt, yteta, ypk)
63c======================================================================
64c Arguments:
65c
66c yt   --------input-R- Temperature
67c yteta-------output-R- Temperature potentielle
68c ypk  --------input-R- Fonction d'Exner: RCPD*(pplay/pref)**RKAPPA
69c
70c======================================================================
71
[37]72      USE control_mod, ONLY: planet_type
73      IMPLICIT NONE
74     
[8]75! for cpp, nu_venus and t0_venus:
76#include "comconst.h"
77
78      integer npoints
79      REAL    yt(npoints), yteta(npoints), ypk(npoints)
80     
81      if (planet_type.eq."venus") then
82          yteta = yt**nu_venus                                          &
83     &            - nu_venus * t0_venus**nu_venus * log(ypk/cpp)
84          yteta = yteta**(1./nu_venus)
85      else
86          yteta = yt * cpp/ypk
87      endif
88
89      return
90      end
91
92c======================================================================
93c======================================================================
94
95      SUBROUTINE t2tpot_p(ip1jmp1,llm, yt, yteta, ypk)
96! Parallel version of t2tpot
97      USE parallel
98      USE control_mod, only : planet_type
99      IMPLICIT none
100
101! for cpp, nu_venus and t0_venus:
102#include "comconst.h"
103
104      integer,intent(in) :: ip1jmp1,llm
105      real,intent(in) :: yt(ip1jmp1,llm)
106      real,intent(out) :: yteta(ip1jmp1,llm)
107      real,intent(in) :: ypk(ip1jmp1,llm)
108! local variable:
109      integer :: ij,l,ijb,ije
110     
[847]111      !ijb=ij_begin
112      !ije=ij_end
113      ijb=1
114      ije=ip1jmp1
115     
[8]116      if (planet_type.eq."venus") then
117!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
118        do l=1,llm
119          yteta(ijb:ije,l)=yt(ijb:ije,l)**nu_venus                      &
120     &                     -nu_venus*t0_venus**nu_venus*                &
121     &                          log(ypk(ijb:ije,l)/cpp)
122          yteta(ijb:ije,l)=yteta(ijb:ije,l)**(1./nu_venus)
123        enddo
124!$OMP END DO
125      else
126!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
127        do l=1,llm
128          yteta(ijb:ije,l)=yt(ijb:ije,l)*cpp/ypk(ijb:ije,l)
129        enddo
130!$OMP END DO
131      endif ! of if (planet_type.eq."venus")
132
133      END
134
135c======================================================================
136
137      SUBROUTINE tpot2t(npoints,yteta, yt, ypk)
138c======================================================================
139c Arguments:
140c
141c yteta--------input-R- Temperature potentielle
142c yt   -------output-R- Temperature
143c ypk  --------input-R- Fonction d'Exner: RCPD*(pplay/pref)**RKAPPA
144c
145c======================================================================
146
[37]147      USE control_mod, ONLY: planet_type
148      IMPLICIT NONE
[8]149
150! for cpp, nu_venus and t0_venus:
151#include "comconst.h"
152
153      integer npoints
154      REAL    yt(npoints), yteta(npoints), ypk(npoints)
155     
156      if (planet_type.eq."venus") then
157         yt = yteta**nu_venus                                           &
158     &       + nu_venus * t0_venus**nu_venus * log(ypk/cpp)
159         yt = yt**(1./nu_venus)
160      else
161          yt = yteta * ypk/cpp
162      endif
163 
164      return
165      end
166
167c======================================================================
168c======================================================================
[847]169      SUBROUTINE tpot2t_p(ip1jmp1,llm,yteta,yt,ypk)
[8]170! Parallel version of tpot2t
171      USE parallel
172      USE control_mod, only : planet_type
173      IMPLICIT none
174! for cpp, nu_venus and t0_venus:
175#include "comconst.h"
176
177      integer,intent(in) :: ip1jmp1,llm
178      real,intent(out) :: yt(ip1jmp1,llm)
179      real,intent(in) :: yteta(ip1jmp1,llm)
180      real,intent(in) :: ypk(ip1jmp1,llm)
[847]181
[8]182! local variable:
183      integer :: ij,l,ijb,ije
184
[847]185      !ijb=ij_begin
186      !ije=ij_end
187      ijb=1
188      ije=ip1jmp1
189
[8]190      if (planet_type.eq."venus") then
191!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
192        do l=1,llm
193          yt(ijb:ije,l)=yteta(ijb:ije,l)**nu_venus                      &
194     &                  +nu_venus*t0_venus**nu_venus*                   &
195     &                       log(ypk(ijb:ije,l)/cpp)
196          yt(ijb:ije,l)=yt(ijb:ije,l)**(1./nu_venus)
197        enddo
198!$OMP END DO
199      else
200!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
201        do l=1,llm
202          yt(ijb:ije,l)=yteta(ijb:ije,l)*ypk(ijb:ije,l)/cpp
203        enddo
204!$OMP END DO
205      endif ! of if (planet_type.eq."venus")
206      END
207
208c======================================================================
209c======================================================================
210c
211c ATTENTION
212c
213c Si un jour on a besoin, il faudra coder les routines
214c    dt2dtpot / dtpto2dt
215c
216c======================================================================
217c======================================================================
Note: See TracBrowser for help on using the repository browser.