source: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/disvert_noterre.f90 @ 5118

Last change on this file since 5118 was 5118, checked in by abarral, 2 months ago

Replace iniprint.h by lmdz_iniprint.f90
(lint) along the way

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 9.2 KB
Line 
1! $Id: $
2SUBROUTINE disvert_noterre
3
4  !    Auteur :  F. Forget Y. Wanherdrick, P. Levan
5  !    Nouvelle version 100% Mars !!
6  !    On l'utilise aussi pour Venus et Titan, legerment modifiee.
7
8  USE IOIPSL
9  USE comvert_mod, ONLY: ap,bp,aps,bps,presnivs,pseudoalt, &
10        nivsig,nivsigs,pa,preff,scaleheight
11  USE comconst_mod, ONLY: kappa
12  USE logic_mod, ONLY: hybrid
13  USE lmdz_iniprint, ONLY: lunout, prt_level
14
15  IMPLICIT NONE
16
17  include "dimensions.h"
18  include "paramet.h"
19  !
20  !=======================================================================
21  !    Discretisation verticale en coordonnée hybride (ou sigma)
22  !
23  !=======================================================================
24  !
25  !   declarations:
26  !   -------------
27  !
28  !
29  INTEGER :: l,ll
30  REAL :: snorm
31  REAL :: alpha,beta,gama,delta,deltaz
32  REAL :: quoi,quand
33  REAL :: zsig(llm),sig(llm+1)
34  INTEGER :: np,ierr
35  INTEGER :: ierr1,ierr2,ierr3,ierr4
36  REAL :: x
37
38  REAL :: SSUM
39  EXTERNAL SSUM
40  REAL :: newsig
41  REAL :: dz0,dz1,nhaut,sig1,esig,csig,zz
42  REAL :: tt,rr,gg, prevz
43  REAL :: s(llm),dsig(llm)
44
45  INTEGER :: iz
46  REAL :: z, ps,p
47  CHARACTER(LEN=*),parameter :: modname="disvert_noterre"
48
49  !
50  !-----------------------------------------------------------------------
51  !
52  ! Initializations:
53  !  pi=2.*ASIN(1.) ! already done in iniconst
54
55  hybrid=.TRUE. ! default value for hybrid (ie: use hybrid coordinates)
56  CALL getin('hybrid',hybrid)
57  WRITE(lunout,*) trim(modname),': hybrid=',hybrid
58
59  ! Ouverture possible de fichiers typiquement E.T.
60
61     open(99,file="esasig.def",status='old',form='formatted', &
62           iostat=ierr2)
63     IF(ierr2/=0) THEN
64          close(99)
65          open(99,file="z2sig.def",status='old',form='formatted', &
66                iostat=ierr4)
67     endif
68
69  !-----------------------------------------------------------------------
70  !   cas 1 on lit les options dans esasig.def:
71  !   ----------------------------------------
72
73  IF(ierr2==0) THEN
74     ! Lecture de esasig.def :
75     ! Systeme peu souple, mais qui respecte en theorie
76     ! La conservation de l'energie (conversion Energie potentielle
77     ! <-> energie cinetique, d'apres la note de Frederic Hourdin...
78
79     WRITE(lunout,*)'*****************************'
80     WRITE(lunout,*)'WARNING reading esasig.def'
81     WRITE(lunout,*)'*****************************'
82     READ(99,*) scaleheight
83     READ(99,*) dz0
84     READ(99,*) dz1
85     READ(99,*) nhaut
86     CLOSE(99)
87
88     dz0=dz0/scaleheight
89     dz1=dz1/scaleheight
90
91     sig1=(1.-dz1)/tanh(.5*(llm-1)/nhaut)
92
93     esig=1.
94
95     do l=1,20
96        esig=-log((1./sig1-1.)*exp(-dz0)/esig)/(llm-1.)
97     enddo
98     csig=(1./sig1-1.)/(exp(esig)-1.)
99
100     DO L = 2, llm
101        zz=csig*(exp(esig*(l-1.))-1.)
102        sig(l) =1./(1.+zz) &
103              * tanh(.5*(llm+1-l)/nhaut)
104     ENDDO
105     sig(1)=1.
106     sig(llm+1)=0.
107     quoi      = 1. + 2.* kappa
108     s( llm )  = 1.
109     s(llm-1) = quoi
110     IF( llm>2 )  THEN
111        DO  ll = 2, llm-1
112           l         = llm+1 - ll
113           quand     = sig(l+1)/ sig(l)
114           s(l-1)    = quoi * (1.-quand) * s(l)  + quand * s(l+1)
115        ENDDO
116     END IF
117  !
118     snorm=(1.-.5*sig(2)+kappa*(1.-sig(2)))*s(1)+.5*sig(2)*s(2)
119     DO l = 1, llm
120        s(l)    = s(l)/ snorm
121     ENDDO
122
123  !-----------------------------------------------------------------------
124  !   cas 2 on lit les options dans z2sig.def:
125  !   ----------------------------------------
126
127  ELSE IF(ierr4==0) THEN
128     WRITE(lunout,*)'****************************'
129     WRITE(lunout,*)'Reading z2sig.def'
130     WRITE(lunout,*)'****************************'
131
132     READ(99,*) scaleheight
133     do l=1,llm
134        read(99,*) zsig(l)
135     END DO
136     CLOSE(99)
137
138     sig(1) =1
139     do l=2,llm
140       sig(l) = 0.5 * ( exp(-zsig(l)/scaleheight) + &
141             exp(-zsig(l-1)/scaleheight) )
142     END DO
143     sig(llm+1) =0
144
145  !-----------------------------------------------------------------------
146  ELSE
147     WRITE(lunout,*) 'didn t you forget something ??? '
148     WRITE(lunout,*) 'We need file  z2sig.def ! (OR esasig.def)'
149     stop
150  ENDIF
151  !-----------------------------------------------------------------------
152
153  DO l=1,llm
154    nivsigs(l) = REAL(l)
155  ENDDO
156
157  DO l=1,llmp1
158    nivsig(l)= REAL(l)
159  ENDDO
160
161
162  !-----------------------------------------------------------------------
163  !    ....  Calculs  de ap(l) et de bp(l)  ....
164  !    .........................................
165  !
166  !   .....  pa et preff sont lus  sur les fichiers start par dynetat0 .....
167  !-----------------------------------------------------------------------
168  !
169
170  IF (hybrid) then  ! use hybrid coordinates
171     WRITE(lunout,*) "*********************************"
172     WRITE(lunout,*) "Using hybrid vertical coordinates"
173     WRITE(lunout,*)
174     ! Coordonnees hybrides avec mod
175     DO l = 1, llm
176
177     CALL sig_hybrid(sig(l),pa,preff,newsig)
178        bp(l) = EXP( 1. - 1./(newsig**2)  )
179        ap(l) = pa * (newsig - bp(l) )
180     enddo
181     bp(llmp1) = 0.
182     ap(llmp1) = 0.
183  else ! use sigma coordinates
184     WRITE(lunout,*) "********************************"
185     WRITE(lunout,*) "Using sigma vertical coordinates"
186     WRITE(lunout,*)
187     ! Pour ne pas passer en coordonnees hybrides
188     DO l = 1, llm
189        ap(l) = 0.
190        bp(l) = sig(l)
191     ENDDO
192     ap(llmp1) = 0.
193  ENDIF
194
195  bp(llmp1) =   0.
196
197  WRITE(lunout,*) trim(modname),': BP '
198  WRITE(lunout,*)  bp
199  WRITE(lunout,*) trim(modname),': AP '
200  WRITE(lunout,*)  ap
201
202  ! Calcul au milieu des couches :
203  ! WARNING : le choix de placer le milieu des couches au niveau de
204  ! pression intermédiaire est arbitraire et pourrait etre modifié.
205  ! Le calcul du niveau pour la derniere couche
206  ! (on met la meme distance (en log pression)  entre P(llm)
207  ! et P(llm -1) qu'entre P(llm-1) et P(llm-2) ) est
208  ! Specifique.  Ce choix est spécifié ici ET dans exner_milieu.F
209
210  DO l = 1, llm-1
211   aps(l) =  0.5 *( ap(l) +ap(l+1))
212   bps(l) =  0.5 *( bp(l) +bp(l+1))
213  ENDDO
214
215  IF (hybrid) THEN
216     aps(llm) = aps(llm-1)**2 / aps(llm-2)
217     bps(llm) = 0.5*(bp(llm) + bp(llm+1))
218  else
219     bps(llm) = bps(llm-1)**2 / bps(llm-2)
220     aps(llm) = 0.
221  end if
222
223  WRITE(lunout,*) trim(modname),': BPs '
224  WRITE(lunout,*)  bps
225  WRITE(lunout,*) trim(modname),': APs'
226  WRITE(lunout,*)  aps
227
228  DO l = 1, llm
229   presnivs(l) = aps(l)+bps(l)*preff
230   pseudoalt(l) = -scaleheight*log(presnivs(l)/preff)
231  ENDDO
232
233  WRITE(lunout,*)trim(modname),' : PRESNIVS'
234  WRITE(lunout,*)presnivs
235  WRITE(lunout,*)'Pseudo altitude of Presnivs : (for a scale ', &
236        'height of ',scaleheight,' km)'
237  WRITE(lunout,*)pseudoalt
238
239  ! --------------------------------------------------
240  ! This can be used to plot the vertical discretization
241  ! (> xmgrace -nxy testhybrid.tab )
242  ! --------------------------------------------------
243  ! open (53,file='testhybrid.tab')
244  ! scaleheight=15.5
245  ! do iz=0,34
246  !   z = -5 + min(iz,34-iz)
247  ! approximation of scale height for Venus
248  !   scaleheight = 15.5 - z/55.*10.
249  !   ps = preff*exp(-z/scaleheight)
250  !   zsig(1)= -scaleheight*log((aps(1) + bps(1)*ps)/preff)
251  !   do l=2,llm
252  ! approximation of scale height for Venus
253  !      if (zsig(l-1).le.55.) THEN
254  !         scaleheight = 15.5 - zsig(l-1)/55.*10.
255  !      else
256  !         scaleheight = 5.5 - (zsig(l-1)-55.)/35.*2.
257  !      endif
258  !      zsig(l)= zsig(l-1)-scaleheight*
259  !    .    log((aps(l) + bps(l)*ps)/(aps(l-1) + bps(l-1)*ps))
260  !   END DO
261  !   WRITE(53,'(I3,50F10.5)') iz, zsig
262  !  END DO
263  !  close(53)
264  ! --------------------------------------------------
265
266
267  RETURN
268END SUBROUTINE disvert_noterre
269
270! ************************************************************
271SUBROUTINE sig_hybrid(sig,pa,preff,newsig)
272  ! ----------------------------------------------
273  ! Subroutine utilisee pour calculer des valeurs de sigma modifie
274  ! pour conserver les coordonnees verticales decrites dans
275  ! esasig.def/z2sig.def lors du passage en coordonnees hybrides
276  ! F. Forget 2002
277  ! Connaissant sig (niveaux "sigma" ou on veut mettre les couches)
278  ! L'objectif est de calculer newsig telle que
279  !   (1 -pa/preff)*exp(1-1./newsig**2)+(pa/preff)*newsig = sig
280  ! Cela ne se résoud pas analytiquement:
281  ! => on résoud par iterration bourrine
282  ! ----------------------------------------------
283  ! Information  : where exp(1-1./x**2) become << x
284  !       x      exp(1-1./x**2) /x
285  !       1           1
286  !       0.68       0.5
287  !       0.5        1.E-1
288  !       0.391      1.E-2
289  !       0.333      1.E-3
290  !       0.295      1.E-4
291  !       0.269      1.E-5
292  !       0.248      1.E-6
293  !    => on peut utiliser newsig = sig*preff/pa si sig*preff/pa < 0.25
294
295
296  IMPLICIT NONE
297  REAL :: x1, x2, sig,pa,preff, newsig, F
298  INTEGER :: j
299
300  newsig = sig
301  x1=0
302  x2=1
303  IF (sig>=1) THEN
304        newsig= sig
305  ELSE IF (sig*preff/pa>=0.25) THEN
306    DO J=1,9999  ! nombre d''iteration max
307      F=((1 -pa/preff)*exp(1-1./newsig**2)+(pa/preff)*newsig)/sig
308      ! WRITE(0,*) J, ' newsig =', newsig, ' F= ', F
309      IF (F>1) THEN
310          X2 = newsig
311          newsig=(X1+newsig)*0.5
312      else
313          X1 = newsig
314          newsig=(X2+newsig)*0.5
315      end if
316      ! Test : on arete lorsque on approxime sig à moins de 0.01 m près
317      ! (en pseudo altitude) :
318      IF(abs(10.*log(F))<1.E-5) goto 999
319    END DO
320   else   !    if (sig*preff/pa.le.0.25) THEN
321         newsig= sig*preff/pa
322   end if
323 999   continue
324   Return
325END SUBROUTINE sig_hybrid
Note: See TracBrowser for help on using the repository browser.