tmm_param.F90 4.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176
  1. !###############################################################################
  2. !
  3. ! NAME
  4. ! tmm_param - parameter specfic keys
  5. !
  6. ! USAGE
  7. !
  8. ! use tmm_param
  9. !
  10. ! ! Character keys for vertical combination,
  11. ! ! to be used as input for 'CopyAndProcess' routine of 'Grid' module.
  12. ! ! Specifies how to combine multiple levels:
  13. ! !
  14. ! ! 'bottom' : use bottom value (most close to the ground)
  15. ! ! 'top' : use top value (most close to the model top)
  16. ! ! 'sum' : sum values
  17. ! ! 'aver' : average of all levels
  18. ! ! 'mass-aver' : mass weighted average
  19. ! !
  20. ! call CombineKey( combkey, 'pu'|'T'|... )
  21. !
  22. !
  23. !### macro's ###################################################################
  24. !
  25. #define TRACEBACK write (gol,'("in ",a," (",a,", line",i5,")")') rname, __FILE__, __LINE__; call goErr
  26. #define IF_NOTOK_RETURN(action) if (status/=0) then; TRACEBACK; action; return; end if
  27. #define IF_ERROR_RETURN(action) if (status> 0) then; TRACEBACK; action; return; end if
  28. !
  29. #include "tmm.inc"
  30. !
  31. !###############################################################################
  32. module tmm_param
  33. implicit none
  34. ! --- in/out ------------------------------
  35. private
  36. public :: GetCombineKeys
  37. ! --- const ---------------------------------------
  38. character(len=*), parameter :: mname = 'module tmm_param'
  39. contains
  40. ! ==============================================================
  41. subroutine GetCombineKeys( hcomb, vcomb, paramkey, status )
  42. ! --- in/out ---------------------------------
  43. character(len=*), intent(out) :: hcomb
  44. character(len=*), intent(out) :: vcomb
  45. character(len=*), intent(in) :: paramkey
  46. integer, intent(out) :: status
  47. ! --- const --------------------------------------
  48. character(len=*), parameter :: name = mname//', GetCombineKeys'
  49. ! --- begin ---------------------------------
  50. select case ( paramkey )
  51. ! ~~~ tm fields ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  52. case ( 'sp', 'spm', 'sp_sfc' )
  53. hcomb = 'area-aver'
  54. vcomb = 'none'
  55. case ( 'oro' , 'lsm' , 'sr', 'srols', 'sr_ols', 'sr_mer', &
  56. 'cvl', 'cvh', &
  57. 'tv01', 'tv02', 'tv03', 'tv04', 'tv05', &
  58. 'tv06', 'tv07', 'tv08', 'tv09', 'tv10', &
  59. 'tv11', 'tv12', 'tv13', 'tv14', 'tv15', &
  60. 'tv16', 'tv17', 'tv18', 'tv19', 'tv20', &
  61. 'swvl1', 'stl1', &
  62. 'al', 'albedo', &
  63. 'lsrh', 'ci' , '10fg', 'g10m', 'u10m', 'v10m', 'sd', &
  64. 'lsp' , 'cp' , 'sf' , 'sshf', 'slhf', 'blh' , &
  65. 't2m' , 'd2m' , &
  66. 'ssr' , 'ssrd', 'str', 'strd', &
  67. 'sstr', 'ewss', 'nsss', &
  68. 'src' , 'raero', 'ustar', &
  69. 'sst' , 'skt', &
  70. 'mlspr', 'mcpr', 'msr', 'msshf','mslhf',&
  71. 'msdwswrf','msdwlwrf','msnswrf','msnlwrf','metss','mntss' )
  72. hcomb = 'area-aver'
  73. vcomb = 'none'
  74. case ( 'pu', 'pv', 'mfu', 'mfv' )
  75. hcomb = 'sum'
  76. vcomb = 'sum'
  77. case ( 'pw', 'mfw' )
  78. hcomb = 'sum'
  79. vcomb = 'bottom'
  80. case ( 'T', 'Tv', 'Q', 'PVo', 'PV', 'theta' )
  81. hcomb = 'mass-aver'
  82. vcomb = 'mass-aver'
  83. case ( 'CLWC', 'CIWC', 'CC', &
  84. 'clwc', 'ciwc', 'cc' )
  85. hcomb = 'mass-aver'
  86. vcomb = 'mass-aver'
  87. case ( 'eu', 'du', 'ed', 'dd' )
  88. hcomb = 'area-aver'
  89. vcomb = 'sum'
  90. ! ecmwf convective fields:
  91. ! o mass fluxes in kg/m2, upper half level
  92. ! o detrainments in kg/m2/m
  93. case ( 'UDMF', 'DDMF', 'MUMF', 'MDMF' )
  94. hcomb = 'area-aver'
  95. vcomb = 'top'
  96. case ( 'UDDR', 'DDDR', 'MUDR', 'MDDR' )
  97. hcomb = 'area-aver'
  98. vcomb = 'height-aver'
  99. ! ecmwf turbulent diffusiton coeff for heat:
  100. ! o upper half level
  101. case ( 'K', 'TDCHA', 'MTDCH' )
  102. hcomb = 'area-aver'
  103. vcomb = 'top'
  104. case ( 'u', 'v', 'wspd' )
  105. hcomb = 'aver'
  106. vcomb = 'aver'
  107. ! relic from the time that TMPP archived meteo in grib files ...
  108. !case ( 'Kz' )
  109. ! hcomb = 'none'
  110. ! vcomb = 'bottom'
  111. case ( 'cco', 'CCO' )
  112. hcomb = 'area-aver'
  113. vcomb = 'bottom'
  114. case ( 'ccu', 'CCU' )
  115. hcomb = 'area-aver'
  116. vcomb = 'top'
  117. ! ~~~ sh/gg fields ~~~~~~~~~~~~~~~~~~~~~
  118. case ( 'lnsp' )
  119. hcomb = 'exp,aver'
  120. vcomb = 'none'
  121. ! ~~~ dummy ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  122. case default
  123. write (*,'("ERROR - do not know how to combine levels for parameter `",a,"`")') paramkey
  124. write (*,'("ERROR in ",a)') name; status=1; return
  125. hcomb = 'unknown'
  126. vcomb = 'unknown'
  127. end select
  128. ! ok
  129. status = 0
  130. end subroutine GetCombineKeys
  131. end module tmm_param