[979] | 1 | ! $Id: pres2lev.F 1179 2009-06-11 14:18:47Z jghattas $ |
---|
| 2 | ! |
---|
| 3 | MODULE pres2lev_mod |
---|
| 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 |
---|