source: trunk/MESOSCALE_DEV/SRC/ARWpost/src/module_calc_td.f90 @ 777

Last change on this file since 777 was 207, checked in by aslmd, 14 years ago

MESOSCALE: A GENERAL CLEAN-UP FOLLOWING UPDATING THE USER MANUAL. EVERYTHING ESSENTIAL IS IN MESOSCALE (much lighter than before). EVERYTHING FOR DEVELOPPERS OR EXPERTS IS IN MESOSCALE_DEV.

File size: 659 bytes
Line 
1!! Diagnostics: Dewpoint Temperature
2
3MODULE module_calc_td
4
5  CONTAINS
6  SUBROUTINE calc_td(SCR, cname, cdesc, cunits)
7
8  USE module_model_basics
9
10  !Arguments
11  real, pointer, dimension(:,:,:)                                :: SCR
12  character (len=128)                                            :: cname, cdesc, cunits
13
14  !Local
15  real, dimension(west_east_dim,south_north_dim,bottom_top_dim)  :: tmp
16 
17
18  tmp      = QV*( PRES /100.)/(0.622+QV)
19  tmp      = AMAX1(tmp,0.001)
20
21  SCR      = (243.5*log(tmp)-440.8)/(19.48-log(tmp))
22  cname    = "td"
23  cdesc    = "Dewpoint Temperature"
24  cunits   = "C"
25 
26  END SUBROUTINE calc_td
27
28END MODULE module_calc_td
Note: See TracBrowser for help on using the repository browser.