- Timestamp:
- Aug 3, 2024, 2:56:58 PM (7 weeks ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_plevel_new.f90
r5159 r5160 1 MODULE lmdz_plevel_new 2 IMPLICIT NONE; PRIVATE 3 PUBLIC plevel_new 4 CONTAINS 1 5 2 ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/plevel.F,v 1.1.1.1.10.1 2006/08/17 3 ! 15:41:51 fairhead Exp $ 6 SUBROUTINE plevel_new(ilon, ilev, klevstd, lnew, pgcm, pres, qgcm, qpres) 7 USE dimphy 8 USE phys_state_var_mod, ONLY: missing_val_nf90 9 USE lmdz_wxios, ONLY: missing_val_xios => missing_val, using_xios 4 10 5 ! ================================================================ 6 ! ================================================================ 7 SUBROUTINE plevel_new(ilon, ilev, klevstd, lnew, pgcm, pres, qgcm, qpres) 8 ! ================================================================ 9 ! ================================================================ 10 USE dimphy 11 USE phys_state_var_mod, ONLY: missing_val_nf90 12 USE lmdz_wxios, ONLY: missing_val_xios=>missing_val, using_xios 11 IMPLICIT NONE 13 12 14 IMPLICIT NONE13 ! ================================================================ 15 14 16 ! ================================================================ 15 ! Interpoler des champs 3-D u, v et g du modele a un niveau de 16 ! pression donnee (pres) 17 17 18 ! Interpoler des champs 3-D u, v et g du modele a un niveau de 19 ! pression donnee (pres) 18 ! INPUT: ilon ----- nombre de points 19 ! ilev ----- nombre de couches 20 ! lnew ----- true si on doit reinitialiser les poids 21 ! pgcm ----- pressions modeles 22 ! pres ----- pression vers laquelle on interpolle 23 ! Qgcm ----- champ GCM 24 ! Qpres ---- champ interpolle au niveau pres 20 25 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 26 ! ================================================================ 28 27 29 ! ================================================================ 28 ! arguments : 29 ! ----------- 30 30 31 ! arguments :32 ! -----------31 INTEGER ilon, ilev, klevstd 32 LOGICAL lnew 33 33 34 INTEGER ilon, ilev, klevstd 35 LOGICAL lnew 34 REAL pgcm(ilon, ilev) 35 REAL qgcm(ilon, ilev) 36 REAL pres(klevstd) 37 REAL qpres(ilon, klevstd) 36 38 37 REAL pgcm(ilon, ilev) 38 REAL qgcm(ilon, ilev) 39 REAL pres(klevstd) 40 REAL qpres(ilon, klevstd) 39 ! local : 40 ! ------- 41 41 42 ! local :43 ! -------42 ! ym INTEGER lt(klon), lb(klon) 43 ! ym REAL ptop, pbot, aist(klon), aisb(klon) 44 44 45 ! ym INTEGER lt(klon), lb(klon) 46 ! ym REAL ptop, pbot, aist(klon), aisb(klon) 45 ! ym save lt,lb,ptop,pbot,aist,aisb 46 INTEGER, ALLOCATABLE, SAVE, DIMENSION (:, :) :: lt, lb 47 REAL, ALLOCATABLE, SAVE, DIMENSION (:, :) :: aist, aisb 48 !$OMP THREADPRIVATE(lt,lb,aist,aisb) 49 REAL, SAVE :: ptop, pbot 50 !$OMP THREADPRIVATE(ptop, pbot) 51 LOGICAL, SAVE :: first = .TRUE. 52 INTEGER :: nlev 53 !$OMP THREADPRIVATE(first) 54 INTEGER i, k 47 55 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 INTEGER :: nlev 56 !$OMP THREADPRIVATE(first) 57 INTEGER i, k 56 REAL :: missing_val 58 57 59 REAL :: missing_val 58 IF (using_xios) THEN 59 missing_val = missing_val_xios 60 ELSE 61 missing_val = missing_val_nf90 62 ENDIF 60 63 61 IF (using_xios) THEN62 missing_val=missing_val_xios63 ELSE64 missing_val=missing_val_nf9065 ENDIF64 IF (first) THEN 65 ALLOCATE (lt(klon, klevstd), lb(klon, klevstd)) 66 ALLOCATE (aist(klon, klevstd), aisb(klon, klevstd)) 67 first = .FALSE. 68 END IF 66 69 67 IF (first) THEN68 ALLOCATE (lt(klon,klevstd), lb(klon,klevstd))69 ALLOCATE (aist(klon,klevstd), aisb(klon,klevstd))70 first = .FALSE.71 END IF72 73 ! =====================================================================74 IF (lnew) THEN75 ! on reinitialise les reindicages et les poids76 70 ! ===================================================================== 71 IF (lnew) THEN 72 ! on reinitialise les reindicages et les poids 73 ! ===================================================================== 77 74 78 75 79 ! Chercher les 2 couches les plus proches du niveau a obtenir76 ! Chercher les 2 couches les plus proches du niveau a obtenir 80 77 81 ! Eventuellement, faire l'extrapolation a partir des deux couches82 ! les plus basses ou les deux couches les plus hautes:78 ! Eventuellement, faire l'extrapolation a partir des deux couches 79 ! les plus basses ou les deux couches les plus hautes: 83 80 81 DO nlev = 1, klevstd 82 DO i = 1, klon 83 IF (abs(pres(nlev) - pgcm(i, ilev))<abs(pres(nlev) - pgcm(i, 1))) THEN 84 lt(i, nlev) = ilev ! 2 85 lb(i, nlev) = ilev - 1 ! 1 86 ELSE 87 lt(i, nlev) = 2 88 lb(i, nlev) = 1 89 END IF 90 END DO 91 DO k = 1, ilev - 1 92 DO i = 1, klon 93 pbot = pgcm(i, k) 94 ptop = pgcm(i, k + 1) 95 IF (ptop<=pres(nlev) .AND. pbot>=pres(nlev)) THEN 96 lt(i, nlev) = k + 1 97 lb(i, nlev) = k 98 END IF 99 END DO 100 END DO 101 102 ! Interpolation lineaire: 103 DO i = 1, klon 104 ! interpolation en logarithme de pression: 105 106 ! ... Modif . P. Le Van ( 20/01/98) .... 107 ! Modif Frederic Hourdin (3/01/02) 108 109 aist(i, nlev) = log(pgcm(i, lb(i, nlev)) / pres(nlev)) / log(pgcm(i, lb(i, & 110 nlev)) / pgcm(i, lt(i, nlev))) 111 aisb(i, nlev) = log(pres(nlev) / pgcm(i, lt(i, nlev))) / log(pgcm(i, lb(i, & 112 nlev)) / pgcm(i, lt(i, nlev))) 113 END DO 114 END DO 115 116 END IF ! lnew 117 118 ! ====================================================================== 119 ! inteprollation 120 ! ET je mets les vents a zero quand je rencontre une montagne 121 ! ====================================================================== 84 122 85 123 DO nlev = 1, klevstd 86 124 DO i = 1, klon 87 IF (abs(pres(nlev)-pgcm(i,ilev))<abs(pres(nlev)-pgcm(i,1))) THEN 88 lt(i, nlev) = ilev ! 2 89 lb(i, nlev) = ilev - 1 ! 1 125 IF (pgcm(i, 1)<pres(nlev)) THEN 126 qpres(i, nlev) = missing_val 90 127 ELSE 91 lt(i, nlev) = 292 lb(i, nlev) = 1128 qpres(i, nlev) = qgcm(i, lb(i, nlev)) * aisb(i, nlev) + & 129 qgcm(i, lt(i, nlev)) * aist(i, nlev) 93 130 END IF 94 END DO95 DO k = 1, ilev - 196 DO i = 1, klon97 pbot = pgcm(i, k)98 ptop = pgcm(i, k+1)99 IF (ptop<=pres(nlev) .AND. pbot>=pres(nlev)) THEN100 lt(i, nlev) = k + 1101 lb(i, nlev) = k102 END IF103 END DO104 END DO105 106 ! Interpolation lineaire:107 DO i = 1, klon108 ! interpolation en logarithme de pression:109 110 ! ... Modif . P. Le Van ( 20/01/98) ....111 ! Modif Frederic Hourdin (3/01/02)112 113 aist(i, nlev) = log(pgcm(i,lb(i,nlev))/pres(nlev))/log(pgcm(i,lb(i, &114 nlev))/pgcm(i,lt(i,nlev)))115 aisb(i, nlev) = log(pres(nlev)/pgcm(i,lt(i,nlev)))/log(pgcm(i,lb(i, &116 nlev))/pgcm(i,lt(i,nlev)))117 131 END DO 118 132 END DO 119 133 120 END IF ! lnew 121 122 ! ====================================================================== 123 ! inteprollation 124 ! ET je mets les vents a zero quand je rencontre une montagne 125 ! ====================================================================== 126 127 DO nlev = 1, klevstd 128 DO i = 1, klon 129 IF (pgcm(i,1)<pres(nlev)) THEN 130 qpres(i, nlev) = missing_val 131 ELSE 132 qpres(i, nlev) = qgcm(i, lb(i,nlev))*aisb(i, nlev) + & 133 qgcm(i, lt(i,nlev))*aist(i, nlev) 134 END IF 135 END DO 136 END DO 137 138 139 140 END SUBROUTINE plevel_new 134 END SUBROUTINE plevel_new 135 END MODULE lmdz_plevel_new
Note: See TracChangeset
for help on using the changeset viewer.
