| 1 | SUBROUTINE 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 | |
|---|
| 74 | USE yomcst_mod_h, ONLY: RPI, RCLUM, RHPLA, RKBOL, RNAVO & |
|---|
| 75 | , RDAY, REA, REPSM, RSIYEA, RSIDAY, ROMEGA & |
|---|
| 76 | , R_ecc, R_peri, R_incl & |
|---|
| 77 | , RA, RG, R1SA & |
|---|
| 78 | , RSIGMA & |
|---|
| 79 | , R, RMD, RMV, RD, RV, RCPD & |
|---|
| 80 | , RMO3, RMCO2, RMC, RMCH4, RMN2O, RMCFC11, RMCFC12 & |
|---|
| 81 | , RCPV, RCVD, RCVV, RKAPPA, RETV, eps_w & |
|---|
| 82 | , RCW, RCS & |
|---|
| 83 | , RLVTT, RLSTT, RLMLT, RTT, RATM & |
|---|
| 84 | , RESTT, RALPW, RBETW, RGAMW, RALPS, RBETS, RGAMS & |
|---|
| 85 | , RALPD, RBETD, RGAMD |
|---|
| 86 | IMPLICIT NONE |
|---|
| 87 | |
|---|
| 88 | |
|---|
| 89 | !IM INTEGER(KIND=JPIM),INTENT(IN) :: KPROMA |
|---|
| 90 | !IM INTEGER(KIND=JPIM),INTENT(IN) :: KSTART |
|---|
| 91 | !IM INTEGER(KIND=JPIM),INTENT(IN) :: KPROF |
|---|
| 92 | INTEGER,INTENT(IN) :: KPROMA |
|---|
| 93 | INTEGER,INTENT(IN) :: KSTART |
|---|
| 94 | INTEGER,INTENT(IN) :: KPROF |
|---|
| 95 | !IM REAL(KIND=JPRB) ,INTENT(IN) :: PTB(KPROMA) |
|---|
| 96 | REAL ,INTENT(IN) :: PTB(KPROMA) |
|---|
| 97 | !IM REAL(KIND=JPRB) ,INTENT(IN) :: PRESBH(KPROMA) |
|---|
| 98 | REAL ,INTENT(IN) :: PRESBH(KPROMA) |
|---|
| 99 | !IM REAL(KIND=JPRB) ,INTENT(IN) :: PRESBF(KPROMA) |
|---|
| 100 | REAL ,INTENT(IN) :: PRESBF(KPROMA) |
|---|
| 101 | !IM REAL(KIND=JPRB) ,INTENT(IN) :: POROG(KPROMA) |
|---|
| 102 | REAL ,INTENT(IN) :: POROG(KPROMA) |
|---|
| 103 | !IM REAL(KIND=JPRB) ,INTENT(OUT) :: PTSTAR(KPROMA) |
|---|
| 104 | REAL ,INTENT(OUT) :: PTSTAR(KPROMA) |
|---|
| 105 | !IM REAL(KIND=JPRB) ,INTENT(OUT) :: PT0(KPROMA) |
|---|
| 106 | REAL ,INTENT(OUT) :: PT0(KPROMA) |
|---|
| 107 | !IM INTEGER(KIND=JPIM) :: JL |
|---|
| 108 | INTEGER :: JL |
|---|
| 109 | |
|---|
| 110 | !IM REAL(KIND=JPRB) :: ZALPHA, ZDTDZSG |
|---|
| 111 | REAL :: ZALPHA, ZDTDZSG |
|---|
| 112 | !IM REAL(KIND=JPRB) :: ZHOOK_HANDLE |
|---|
| 113 | REAL :: ZHOOK_HANDLE |
|---|
| 114 | !IM beg |
|---|
| 115 | REAL, PARAMETER :: RDTDZ1=-0.0065 !or USE YOMSTA |
|---|
| 116 | !IM end |
|---|
| 117 | |
|---|
| 118 | ! ------------------------------------------------------------------ |
|---|
| 119 | |
|---|
| 120 | !* 1. COMPUTES SURFACE TEMPERATURE |
|---|
| 121 | !* THEN STANDARD SURFACE TEMPERATURE. |
|---|
| 122 | |
|---|
| 123 | !IF (LHOOK) CALL DR_HOOK('CTSTAR',0,ZHOOK_HANDLE) |
|---|
| 124 | ZDTDZSG=-RDTDZ1/RG |
|---|
| 125 | !<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/xrd/support/rg.F.php#rg> |
|---|
| 126 | ZALPHA=ZDTDZSG*RD |
|---|
| 127 | DO JL=KSTART,KPROF |
|---|
| 128 | |
|---|
| 129 | !IM PTSTAR(JL)=PTB(JL)*(1.0_JPRB+ZALPHA*(PRESBH(JL)/PRESBF(JL)-1.0_JPRB)) |
|---|
| 130 | PTSTAR(JL)=PTB(JL)*(1.0+ZALPHA*(PRESBH(JL)/PRESBF(JL)-1.0)) |
|---|
| 131 | PT0(JL)=PTSTAR(JL)+ZDTDZSG*POROG(JL) |
|---|
| 132 | ! print*,'cstar JL ptb zalpha PRESBH PRESBF ptstar' & |
|---|
| 133 | ! ,JL,PTB(JL),ZALPHA,PRESBH(JL),PRESBF(JL),PTSTAR(JL) |
|---|
| 134 | ENDDO |
|---|
| 135 | |
|---|
| 136 | |
|---|
| 137 | ! ------------------------------------------------------------------ |
|---|
| 138 | |
|---|
| 139 | !IF (LHOOK) CALL DR_HOOK('CTSTAR',1,ZHOOK_HANDLE) |
|---|
| 140 | END SUBROUTINE CTSTAR |
|---|
