Changeset 1992 for LMDZ5/trunk/libf/phylmd/plevel.F90
- Timestamp:
- Mar 5, 2014, 2:19:12 PM (10 years ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/trunk/libf/phylmd/plevel.F90
r1988 r1992 1 ! 1 2 2 ! $Header$ 3 !4 c================================================================5 c================================================================6 SUBROUTINE plevel(ilon,ilev,lnew,pgcm,pres,Qgcm,Qpres)7 c================================================================8 c================================================================9 USE netcdf10 USE dimphy11 IMPLICIT none12 3 13 cym#include "dimensions.h" 14 cy#include "dimphy.h" 4 ! ================================================================ 5 ! ================================================================ 6 SUBROUTINE plevel(ilon, ilev, lnew, pgcm, pres, qgcm, qpres) 7 ! ================================================================ 8 ! ================================================================ 9 USE netcdf 10 USE dimphy 11 IMPLICIT NONE 15 12 16 c================================================================ 17 c 18 c Interpoler des champs 3-D u, v et g du modele a un niveau de 19 c pression donnee (pres) 20 c 21 c INPUT: ilon ----- nombre de points 22 c ilev ----- nombre de couches 23 c lnew ----- true si on doit reinitialiser les poids 24 c pgcm ----- pressions modeles 25 c pres ----- pression vers laquelle on interpolle 26 c Qgcm ----- champ GCM 27 c Qpres ---- champ interpolle au niveau pres 28 c 29 c================================================================ 30 c 31 c arguments : 32 c ----------- 13 ! ym#include "dimensions.h" 14 ! y#include "dimphy.h" 33 15 34 INTEGER ilon, ilev 35 logical lnew 16 ! ================================================================ 36 17 37 REAL pgcm(ilon,ilev) 38 REAL Qgcm(ilon,ilev) 39 real pres 40 REAL Qpres(ilon) 18 ! Interpoler des champs 3-D u, v et g du modele a un niveau de 19 ! pression donnee (pres) 41 20 42 c local : 43 c ------- 21 ! INPUT: ilon ----- nombre de points 22 ! ilev ----- nombre de couches 23 ! lnew ----- true si on doit reinitialiser les poids 24 ! pgcm ----- pressions modeles 25 ! pres ----- pression vers laquelle on interpolle 26 ! Qgcm ----- champ GCM 27 ! Qpres ---- champ interpolle au niveau pres 44 28 45 cym INTEGER lt(klon), lb(klon) 46 cym REAL ptop, pbot, aist(klon), aisb(klon) 29 ! ================================================================ 47 30 48 cym save lt,lb,ptop,pbot,aist,aisb 49 INTEGER,ALLOCATABLE,SAVE,DIMENSION(:) :: lt,lb 50 REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: aist,aisb 51 c$OMP THREADPRIVATE(lt,lb,aist,aisb) 52 REAL,SAVE :: ptop, pbot 53 c$OMP THREADPRIVATE(ptop, pbot) 54 LOGICAL,SAVE :: first = .true. 55 c$OMP THREADPRIVATE(first) 56 INTEGER i, k 57 c 58 REAL missing_val 59 c 60 missing_val=nf90_fill_real 61 c 62 if (first) then 63 allocate(lt(klon),lb(klon),aist(klon),aisb(klon)) 64 first=.false. 65 endif 66 67 c===================================================================== 68 if (lnew) then 69 c on r�nitialise les r�ndicages et les poids 70 c===================================================================== 31 ! arguments : 32 ! ----------- 33 34 INTEGER ilon, ilev 35 LOGICAL lnew 36 37 REAL pgcm(ilon, ilev) 38 REAL qgcm(ilon, ilev) 39 REAL pres 40 REAL qpres(ilon) 41 42 ! local : 43 ! ------- 44 45 ! ym INTEGER lt(klon), lb(klon) 46 ! ym REAL ptop, pbot, aist(klon), aisb(klon) 47 48 ! ym save lt,lb,ptop,pbot,aist,aisb 49 INTEGER, ALLOCATABLE, SAVE, DIMENSION (:) :: lt, lb 50 REAL, ALLOCATABLE, SAVE, DIMENSION (:) :: aist, aisb 51 !$OMP THREADPRIVATE(lt,lb,aist,aisb) 52 REAL, SAVE :: ptop, pbot 53 !$OMP THREADPRIVATE(ptop, pbot) 54 LOGICAL, SAVE :: first = .TRUE. 55 !$OMP THREADPRIVATE(first) 56 INTEGER i, k 57 58 REAL missing_val 59 60 missing_val = nf90_fill_real 61 62 IF (first) THEN 63 ALLOCATE (lt(klon), lb(klon), aist(klon), aisb(klon)) 64 first = .FALSE. 65 END IF 66 67 ! ===================================================================== 68 IF (lnew) THEN 69 ! on r�nitialise les r�ndicages et les poids 70 ! ===================================================================== 71 71 72 72 73 c Chercher les 2 couches les plus proches du niveau a obtenir 74 c 75 c Eventuellement, faire l'extrapolation a partir des deux couches 76 c les plus basses ou les deux couches les plus hautes: 77 DO 130 i = 1, klon 78 IF ( ABS(pres-pgcm(i,ilev) ) .LT. 79 . ABS(pres-pgcm(i,1)) ) THEN 80 lt(i) = ilev ! 2 81 lb(i) = ilev-1 ! 1 82 ELSE 83 lt(i) = 2 84 lb(i) = 1 85 ENDIF 86 130 CONTINUE 87 DO 150 k = 1, ilev-1 88 DO 140 i = 1, klon 89 pbot = pgcm(i,k) 90 ptop = pgcm(i,k+1) 91 IF (ptop.LE.pres .AND. pbot.GE.pres) THEN 92 lt(i) = k+1 93 lb(i) = k 94 ENDIF 95 140 CONTINUE 96 150 CONTINUE 97 c 98 c Interpolation lineaire: 99 c 73 ! Chercher les 2 couches les plus proches du niveau a obtenir 74 75 ! Eventuellement, faire l'extrapolation a partir des deux couches 76 ! les plus basses ou les deux couches les plus hautes: 77 DO i = 1, klon 78 IF (abs(pres-pgcm(i,ilev))<abs(pres-pgcm(i,1))) THEN 79 lt(i) = ilev ! 2 80 lb(i) = ilev - 1 ! 1 81 ELSE 82 lt(i) = 2 83 lb(i) = 1 84 END IF 85 END DO 86 DO k = 1, ilev - 1 100 87 DO i = 1, klon 101 c interpolation en logarithme de pression: 102 c 103 c ... Modif . P. Le Van ( 20/01/98) .... 104 c Modif Fr��ic Hourdin (3/01/02) 88 pbot = pgcm(i, k) 89 ptop = pgcm(i, k+1) 90 IF (ptop<=pres .AND. pbot>=pres) THEN 91 lt(i) = k + 1 92 lb(i) = k 93 END IF 94 END DO 95 END DO 105 96 106 aist(i) = LOG( pgcm(i,lb(i))/ pres ) 107 . / LOG( pgcm(i,lb(i))/ pgcm(i,lt(i)) ) 108 aisb(i) = LOG( pres / pgcm(i,lt(i)) ) 109 . / LOG( pgcm(i,lb(i))/ pgcm(i,lt(i))) 110 enddo 97 ! Interpolation lineaire: 98 99 DO i = 1, klon 100 ! interpolation en logarithme de pression: 101 102 ! ... Modif . P. Le Van ( 20/01/98) .... 103 ! Modif Fr��ic Hourdin (3/01/02) 104 105 aist(i) = log(pgcm(i,lb(i))/pres)/log(pgcm(i,lb(i))/pgcm(i,lt(i))) 106 aisb(i) = log(pres/pgcm(i,lt(i)))/log(pgcm(i,lb(i))/pgcm(i,lt(i))) 107 END DO 111 108 112 109 113 endif! lnew110 END IF ! lnew 114 111 115 c======================================================================116 cinteprollation117 c======================================================================112 ! ====================================================================== 113 ! inteprollation 114 ! ====================================================================== 118 115 119 do i=1,klon 120 Qpres(i)= Qgcm(i,lb(i))*aisb(i)+Qgcm(i,lt(i))*aist(i) 121 enddo 122 c 123 c Je mets les vents a zero quand je rencontre une montagne 124 do i = 1, klon 125 if (pgcm(i,1).LT.pres) THEN 126 Qpres(i)=missing_val 127 endif 128 enddo 116 DO i = 1, klon 117 qpres(i) = qgcm(i, lb(i))*aisb(i) + qgcm(i, lt(i))*aist(i) 118 END DO 129 119 130 c 131 RETURN 132 END 120 ! Je mets les vents a zero quand je rencontre une montagne 121 DO i = 1, klon 122 IF (pgcm(i,1)<pres) THEN 123 qpres(i) = missing_val 124 END IF 125 END DO 126 127 128 RETURN 129 END SUBROUTINE plevel
Note: See TracChangeset
for help on using the changeset viewer.