My Project
 All Classes Files Functions Variables Macros
pres2lev_mod.F90
Go to the documentation of this file.
1 ! $Id: pres2lev.F 1179 2009-06-11 14:18:47Z jghattas $
2 !
4 
5 CONTAINS
6 
7 !******************************************************
8 SUBROUTINE pres2lev(varo,varn,lmo,lmn,po,pn,ni,nj,ok_invertp)
9 !
10 ! interpolation lineaire pour passer
11 ! a une nouvelle discretisation verticale pour
12 ! les variables de GCM
13 ! Francois Forget (01/1995)
14 ! MOdif remy roca 12/97 pour passer de pres2sig
15 ! Modif F.Codron 07/08 po en 3D
16 !**********************************************************
17 
18  IMPLICIT NONE
19 
20 ! Declarations:
21 ! ==============
22 !
23 ! ARGUMENTS
24 ! """""""""
25  LOGICAL, INTENT(IN) :: ok_invertp
26  INTEGER, INTENT(IN) :: lmo ! dimensions ancienne couches
27  INTEGER, INTENT(IN) :: lmn ! dimensions nouvelle couches
28 
29  REAL, INTENT(IN) :: po(ni*nj,lmo) ! niveau de pression ancienne grille
30  REAL, INTENT(IN) :: pn(ni*nj,lmn) ! niveau de pression nouvelle grille
31 
32  INTEGER, INTENT(IN) :: ni,nj ! nombre de point horizontal
33 
34  REAL, INTENT(IN) :: varo(ni*nj,lmo) ! var dans l'ancienne grille
35  REAL, INTENT(OUT) :: varn(ni*nj,lmn) ! var dans la nouvelle grille
36 
37  REAL :: zvaro(ni*nj,lmo),zpo(ni*nj,lmo)
38 
39 ! Autres variables
40 ! """"""""""""""""
41  INTEGER :: ln ,lo, k
42  REAL :: coef
43 
44 
45 ! Inversion de l'ordre des niveaux verticaux
46  IF (ok_invertp) THEN
47  DO lo=1,lmo
48  DO k=1,ni*nj
49  zpo(k,lo)=po(k,lmo+1-lo)
50  zvaro(k,lo)=varo(k,lmo+1-lo)
51  ENDDO
52  ENDDO
53  ELSE
54  DO lo=1,lmo
55  DO k=1,ni*nj
56  zpo(k,lo)=po(k,lo)
57  zvaro(k,lo)=varo(k,lo)
58  ENDDO
59  ENDDO
60  ENDIF
61 
62  DO ln=1,lmn
63  DO lo=1,lmo-1
64  DO k=1,ni*nj
65  IF (pn(k,ln) >= zpo(k,1) ) THEN
66  varn(k,ln) = zvaro(k,1)
67  ELSE IF (pn(k,ln) <= zpo(k,lmo)) THEN
68  varn(k,ln) = zvaro(k,lmo)
69  ELSE IF ( pn(k,ln) <= zpo(k,lo) .AND. pn(k,ln) > zpo(k,lo+1) ) THEN
70  coef = (pn(k,ln)-zpo(k,lo)) / (zpo(k,lo+1)-zpo(k,lo))
71  varn(k,ln) = zvaro(k,lo) + coef*(zvaro(k,lo+1)-zvaro(k,lo))
72  ENDIF
73 
74  ENDDO
75  ENDDO
76  ENDDO
77 
78 END SUBROUTINE pres2lev
79 
80 END MODULE pres2lev_mod