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