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