source: LMDZ6/branches/Test_modipsl/libf/phylmd/ctstar.F90 @ 5064

Last change on this file since 5064 was 2386, checked in by musat, 9 years ago

Ajout routines calcul slp

File size: 4.2 KB
Line 
1SUBROUTINE CTSTAR(KPROMA,KSTART,KPROF,PTB,PRESBH,PRESBF,POROG,PTSTAR,PT0)
2
3!**** *CTSTAR* - COMPUTES STANDARD SURFACE TEMPERATURE
4!                              AND SURFACE TEMPERATURE.
5
6!     PURPOSE.
7!     --------
8
9!           COMPUTES THE STANDARD SURFACE TEMPERATURE AND THE SURFACE
10!           TEMPERATURE TO BE USED FOR EXTRAPOLATIONS OF TEMPERATURE
11!           AND GEOPOTENTIEL.
12
13!**   INTERFACE.
14!     ----------
15!        *CALL* *CTSTAR(..)*
16
17!        EXPLICIT ARGUMENTS
18!        --------------------
19
20!        KPROMA         - HORIZONTAL DIMENSIONS.             (INPUT)
21!        KSTART         - START OF WORK                      (INPUT)
22!        KPROF          - DEPTH OF WORK                      (INPUT)
23
24!        PTB(KPROMA)    - TEMPERATURE AT NFLEVG-1             (INPUT)
25!        PRESBH(KPROMA) - LOWEST MODEL HALF LEVEL PRESSURES  (INPUT)
26
27!        PRESBF(KPROMA) - PRESSURE AT NFLEVG-1                (INPUT)
28!        POROG(KPROMA)  - MODEL ORGRAPHY                     (INPUT)
29
30
31!        PTSTAR(KPROMA) - SURFACE TEMPERATURE                (OUTPUT)
32
33!        PT0(KPROMA)    - STANDARD SURFACE TEMPERATURE       (OUTPUT)
34
35!        IMPLICIT ARGUMENTS :    CONSTANTS FROM YOMSTA,YOMCST.
36!        --------------------
37
38!     METHOD.
39!     -------
40!        SEE DOCUMENTATION
41
42!     EXTERNALS.   NONE.
43!     ----------
44
45!     REFERENCE.
46!     ----------
47!        ECMWF Research Department documentation of the IFS
48
49!     AUTHOR.
50!     -------
51!        MATS HAMRUD AND PHILIPPE COURTIER  *ECMWF*
52
53!     MODIFICATIONS.
54!     --------------
55!        ORIGINAL : 89-05-02
56
57!      Modification : 93-06-01 M.Hamrud (Comment only, now T from NFLEVG-1)
58!        M.Hamrud      01-Oct-2003 CY28 Cleaning
59
60!     ------------------------------------------------------------------
61
62!USE PARKIND1
63!<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/xrd/module/parkind1.F90.php#parkind1>  ,ONLY : JPIM     ,JPRB
64!USE YOMHOOK
65!<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/xrd/module/yomhook.F90.php#yomhook>   ,ONLY : LHOOK,   DR_HOOK
66
67!USE YOMCST, ONLY : RG, RD
68!<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/arp/module/yomcst.F90.php#yomcst>   , ONLY :  RG
69
70!<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/xrd/support/rg.F.php#rg>       ,RD
71!USE YOMSTA
72!<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/arp/module/yomsta.F90.php#yomsta>   , ONLY : RDTDZ1
73
74IMPLICIT NONE
75
76include "YOMCST.h"
77!IM INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMA
78!IM INTEGER(KIND=JPIM),INTENT(IN)    :: KSTART
79!IM INTEGER(KIND=JPIM),INTENT(IN)    :: KPROF
80INTEGER,INTENT(IN)    :: KPROMA
81INTEGER,INTENT(IN)    :: KSTART
82INTEGER,INTENT(IN)    :: KPROF
83!IM REAL(KIND=JPRB)   ,INTENT(IN)    :: PTB(KPROMA)
84REAL   ,INTENT(IN)    :: PTB(KPROMA)
85!IM REAL(KIND=JPRB)   ,INTENT(IN)    :: PRESBH(KPROMA)
86REAL   ,INTENT(IN)    :: PRESBH(KPROMA)
87!IM REAL(KIND=JPRB)   ,INTENT(IN)    :: PRESBF(KPROMA)
88REAL   ,INTENT(IN)    :: PRESBF(KPROMA)
89!IM REAL(KIND=JPRB)   ,INTENT(IN)    :: POROG(KPROMA)
90REAL   ,INTENT(IN)    :: POROG(KPROMA)
91!IM REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTSTAR(KPROMA)
92REAL   ,INTENT(OUT)   :: PTSTAR(KPROMA)
93!IM REAL(KIND=JPRB)   ,INTENT(OUT)   :: PT0(KPROMA)
94REAL   ,INTENT(OUT)   :: PT0(KPROMA)
95!IM INTEGER(KIND=JPIM) :: JL
96INTEGER :: JL
97
98!IM REAL(KIND=JPRB) :: ZALPHA, ZDTDZSG
99REAL :: ZALPHA, ZDTDZSG
100!IM REAL(KIND=JPRB) :: ZHOOK_HANDLE
101REAL :: ZHOOK_HANDLE
102!IM beg
103REAL, PARAMETER                  :: RDTDZ1=-0.0065 !or USE YOMSTA
104!IM end
105
106!     ------------------------------------------------------------------
107
108!*       1.    COMPUTES SURFACE TEMPERATURE
109!*             THEN STANDARD SURFACE TEMPERATURE.
110
111!IF (LHOOK) CALL DR_HOOK('CTSTAR',0,ZHOOK_HANDLE)
112ZDTDZSG=-RDTDZ1/RG
113!<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/xrd/support/rg.F.php#rg>
114ZALPHA=ZDTDZSG*RD
115DO JL=KSTART,KPROF
116
117   !IM PTSTAR(JL)=PTB(JL)*(1.0_JPRB+ZALPHA*(PRESBH(JL)/PRESBF(JL)-1.0_JPRB))
118   PTSTAR(JL)=PTB(JL)*(1.0+ZALPHA*(PRESBH(JL)/PRESBF(JL)-1.0))
119   PT0(JL)=PTSTAR(JL)+ZDTDZSG*POROG(JL)
120!  print*,'cstar JL ptb zalpha PRESBH PRESBF ptstar' &
121!  ,JL,PTB(JL),ZALPHA,PRESBH(JL),PRESBF(JL),PTSTAR(JL)
122ENDDO
123
124
125!     ------------------------------------------------------------------
126
127!IF (LHOOK) CALL DR_HOOK('CTSTAR',1,ZHOOK_HANDLE)
128END SUBROUTINE CTSTAR
Note: See TracBrowser for help on using the repository browser.