source: LMDZ6/trunk/libf/phylmd/ctstar.f90 @ 5407

Last change on this file since 5407 was 5285, checked in by abarral, 7 weeks ago

As discussed internally, remove generic ONLY: ... for new _mod_h modules

File size: 4.2 KB
RevLine 
[2386]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
[5285]74USE yomcst_mod_h
[2386]75IMPLICIT NONE
76
[5274]77
[2386]78!IM INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMA
79!IM INTEGER(KIND=JPIM),INTENT(IN)    :: KSTART
80!IM INTEGER(KIND=JPIM),INTENT(IN)    :: KPROF
81INTEGER,INTENT(IN)    :: KPROMA
82INTEGER,INTENT(IN)    :: KSTART
83INTEGER,INTENT(IN)    :: KPROF
84!IM REAL(KIND=JPRB)   ,INTENT(IN)    :: PTB(KPROMA)
85REAL   ,INTENT(IN)    :: PTB(KPROMA)
86!IM REAL(KIND=JPRB)   ,INTENT(IN)    :: PRESBH(KPROMA)
87REAL   ,INTENT(IN)    :: PRESBH(KPROMA)
88!IM REAL(KIND=JPRB)   ,INTENT(IN)    :: PRESBF(KPROMA)
89REAL   ,INTENT(IN)    :: PRESBF(KPROMA)
90!IM REAL(KIND=JPRB)   ,INTENT(IN)    :: POROG(KPROMA)
91REAL   ,INTENT(IN)    :: POROG(KPROMA)
92!IM REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTSTAR(KPROMA)
93REAL   ,INTENT(OUT)   :: PTSTAR(KPROMA)
94!IM REAL(KIND=JPRB)   ,INTENT(OUT)   :: PT0(KPROMA)
95REAL   ,INTENT(OUT)   :: PT0(KPROMA)
96!IM INTEGER(KIND=JPIM) :: JL
97INTEGER :: JL
98
99!IM REAL(KIND=JPRB) :: ZALPHA, ZDTDZSG
100REAL :: ZALPHA, ZDTDZSG
101!IM REAL(KIND=JPRB) :: ZHOOK_HANDLE
102REAL :: ZHOOK_HANDLE
103!IM beg
104REAL, PARAMETER                  :: RDTDZ1=-0.0065 !or USE YOMSTA
105!IM end
106
107!     ------------------------------------------------------------------
108
109!*       1.    COMPUTES SURFACE TEMPERATURE
110!*             THEN STANDARD SURFACE TEMPERATURE.
111
112!IF (LHOOK) CALL DR_HOOK('CTSTAR',0,ZHOOK_HANDLE)
113ZDTDZSG=-RDTDZ1/RG
114!<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/xrd/support/rg.F.php#rg>
115ZALPHA=ZDTDZSG*RD
116DO JL=KSTART,KPROF
117
118   !IM PTSTAR(JL)=PTB(JL)*(1.0_JPRB+ZALPHA*(PRESBH(JL)/PRESBF(JL)-1.0_JPRB))
119   PTSTAR(JL)=PTB(JL)*(1.0+ZALPHA*(PRESBH(JL)/PRESBF(JL)-1.0))
120   PT0(JL)=PTSTAR(JL)+ZDTDZSG*POROG(JL)
121!  print*,'cstar JL ptb zalpha PRESBH PRESBF ptstar' &
122!  ,JL,PTB(JL),ZALPHA,PRESBH(JL),PRESBF(JL),PTSTAR(JL)
123ENDDO
124
125
126!     ------------------------------------------------------------------
127
128!IF (LHOOK) CALL DR_HOOK('CTSTAR',1,ZHOOK_HANDLE)
129END SUBROUTINE CTSTAR
Note: See TracBrowser for help on using the repository browser.