[1279] | 1 | ! $Id: pres2lev.F 1279 2009-12-10 09:02:56Z musat $ |
---|
[524] | 2 | ! |
---|
| 3 | c****************************************************** |
---|
| 4 | SUBROUTINE pres2lev(varo,varn,lmo,lmn,po,pn, |
---|
[1046] | 5 | % ni,nj,ok_invertp) |
---|
[524] | 6 | c |
---|
| 7 | c interpolation lineaire pour passer |
---|
| 8 | c a une nouvelle discretisation verticale pour |
---|
| 9 | c les variables de GCM |
---|
| 10 | c Francois Forget (01/1995) |
---|
| 11 | c MOdif remy roca 12/97 pour passer de pres2sig |
---|
[1046] | 12 | c Modif F.Codron 07/08 po en 3D |
---|
[524] | 13 | c********************************************************** |
---|
| 14 | |
---|
| 15 | IMPLICIT NONE |
---|
| 16 | |
---|
| 17 | c Declarations: |
---|
| 18 | c ============== |
---|
| 19 | c |
---|
| 20 | c ARGUMENTS |
---|
| 21 | c """"""""" |
---|
[1279] | 22 | LOGICAL, INTENT(IN) :: ok_invertp |
---|
| 23 | INTEGER, INTENT(IN) :: lmo ! dimensions ancienne couches |
---|
| 24 | INTEGER, INTENT(IN) :: lmn ! dimensions nouvelle couches |
---|
| 25 | INTEGER lmomx ! dimensions ancienne couches |
---|
| 26 | INTEGER lmnmx ! dimensions nouvelle couches |
---|
[524] | 27 | |
---|
| 28 | parameter(lmomx=10000,lmnmx=10000) |
---|
| 29 | |
---|
[1279] | 30 | real, INTENT(IN) :: po(ni,nj,lmo) ! niveau de pression ancienne grille |
---|
| 31 | real, INTENT(IN) :: pn(ni,nj,lmn) ! niveau de pression nouvelle grille |
---|
[524] | 32 | |
---|
[1279] | 33 | INTEGER, INTENT(IN) :: ni,nj ! nombre de point horizontale |
---|
[524] | 34 | |
---|
[1279] | 35 | REAL, INTENT(IN) :: varo(ni,nj,lmo) ! var dans l'ancienne grille |
---|
| 36 | REAL, INTENT(OUT) :: varn(ni,nj,lmn) ! var dans la nouvelle grille |
---|
[524] | 37 | |
---|
| 38 | real zvaro(lmomx),zpo(lmomx) |
---|
| 39 | |
---|
| 40 | c Autres variables |
---|
| 41 | c """""""""""""""" |
---|
[1279] | 42 | INTEGER n, ln ,lo, i, j, Nhoriz |
---|
[524] | 43 | REAL coef |
---|
| 44 | |
---|
| 45 | c run |
---|
| 46 | c ==== |
---|
| 47 | do i=1,ni |
---|
| 48 | do j=1,nj |
---|
[1046] | 49 | ! Inversion de l'ordre des niveaux verticaux |
---|
| 50 | IF (ok_invertp) THEN |
---|
[524] | 51 | do lo=1,lmo |
---|
[1046] | 52 | zpo(lo)=po(i,j,lmo+1-lo) |
---|
[524] | 53 | zvaro(lo)=varo(i,j,lmo+1-lo) |
---|
| 54 | enddo |
---|
[1046] | 55 | ELSE |
---|
| 56 | do lo=1,lmo |
---|
| 57 | zpo(lo)=po(i,j,lo) |
---|
| 58 | zvaro(lo)=varo(i,j,lo) |
---|
| 59 | enddo |
---|
| 60 | ENDIF |
---|
| 61 | |
---|
[524] | 62 | do ln=1,lmn |
---|
| 63 | if (pn(i,j,ln).ge.zpo(1))then |
---|
| 64 | varn(i,j,ln) = zvaro(1) |
---|
| 65 | else if (pn(i,j,ln).le.zpo(lmo)) then |
---|
| 66 | varn(i,j,ln) = zvaro(lmo) |
---|
| 67 | else |
---|
| 68 | do lo=1,lmo-1 |
---|
| 69 | if ( (pn(i,j,ln).le.zpo(lo)).and. |
---|
| 70 | & (pn(i,j,ln).gt.zpo(lo+1)) )then |
---|
| 71 | coef=(pn(i,j,ln)-zpo(lo)) |
---|
| 72 | & /(zpo(lo+1)-zpo(lo)) |
---|
| 73 | varn(i,j,ln)=zvaro(lo) |
---|
| 74 | & +coef*(zvaro(lo+1)-zvaro(lo)) |
---|
| 75 | c print*,'pn(',ln,')=',pn(i,j,ln),varn(i,j,ln) |
---|
| 76 | end if |
---|
| 77 | enddo |
---|
| 78 | endif |
---|
| 79 | enddo |
---|
| 80 | |
---|
| 81 | enddo |
---|
| 82 | enddo |
---|
| 83 | return |
---|
| 84 | end |
---|