UPP  V11.0.0
 All Data Structures Files Functions Pages
MICROINIT.F
1  SUBROUTINE microinit(imp_physics)
2 !
3 !-- ABSTRACT:
4 ! Initializes arrays for new cloud microphysics
5 !
6 !-- Program History Log:
7 ! 02-02-08 B. Ferrier
8 ! 04-11-19 H CHUANG - WRF VERSION
9 !
10 !-- Input argument list:
11 ! None
12 !
13 !-- Output argument list:
14 ! None
15 !
16 !-- Subprograms called:
17 ! Function FPVS
18 !
19 !-- Common blocks:
20 ! CMASSI
21 ! RMASS_TABLES
22 ! MAPOT
23 ! CRHgrd
24 !
25 !-- Attributes:
26 ! Language: FORTRAN 90
27 ! Machine : IBM SP
28 !
29 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
30  use params_mod, only: tfrz, pi
31  use cmassi_mod, only: dmrmax, t_ice, nlimax, flarge2, xmrmax, &
32  mdrmax, mdrmin, trad_ice, massi, &
33  rqr_drmin, n0r0, rqr_drmax, cn0r0, &
34  cn0r_dmrmin, cn0r_dmrmax, dmrmin
35  use gridspec_mod,only : gridtype
36  use rhgrd_mod, only: rhgrd
37  use ctlblk_mod, only: me
38 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
39  implicit none
40 !
41  REAL, PARAMETER :: rhol=1000.
42  real ax,c_n0r0
43  integer i
44  integer, intent(in):: imp_physics
45  real, allocatable:: massr(:)
46  character filename*80
47 !
48 !------------------------ START EXECUTION ------------------------
49 !
50 !--- READ IN MASSI FROM LOOKUP TABLES
51 !
52  if(imp_physics==5 .or. imp_physics==15)then
53 !-- Changes associated with the Ferrier-Aligo microphysics in NMMB:
54 ! NLImax is now defined internally and FLARGE2 is no longer used.
55  rhgrd=0.98
56  dmrmax=1.e-3
57  else if(imp_physics==85)then
58  rhgrd=1. !-- Approximation, as it varies in HWRF for different grids
59  nlimax=20.e3
60  flarge2=0.2
61  dmrmax=.45e-3
62  else if(imp_physics==95)then
63  rhgrd=1.
64  nlimax=5.e3
65  if(gridtype=="B") then
66  flarge2=0.03
67  dmrmax=.45e-3
68  else
69  flarge2=0.2
70  dmrmax=1.e-3
71  endif
72  endif
73 
74 #if defined(COMMCODE)
75  ! If community code, check DMRmax to determine which file to link
76  if (dmrmax<=0.45e-3) then
77  filename = "nam_micro_lookup.dat"
78  else
79  filename = "hires_micro_lookup.dat"
80  endif
81 #else
82  ! Else operational code and use this file
83  filename = "eta_micro_lookup.dat"
84 #endif
85 
86  t_ice=-40. !-- Now used in all versions.
87  xmrmax=1.e6*dmrmax
88  mdrmax=xmrmax
89  allocate(massr(mdrmin:mdrmax))
90  trad_ice=0.5*t_ice+tfrz
91 
92  OPEN (unit=1,file=filename,convert='big_endian',form="UNFORMATTED")
93  DO i=1,3
94  READ(1)
95  ENDDO
96  READ(1) massr
97  DO i=1,5
98  READ(1)
99  ENDDO
100  READ(1) massi
101  CLOSE(1)
102  rqr_drmin=n0r0*massr(mdrmin) ! Rain content for mean drop diameter of .05 mm
103  rqr_drmax=n0r0*massr(mdrmax) ! Rain content for mean drop diameter of .45 mm
104 ! PI=ACOS(-1.) ! defined in params now
105  c_n0r0=pi*rhol*n0r0
106  cn0r0=1.e6/sqrt(sqrt(c_n0r0))
107  cn0r_dmrmin=1./(pi*rhol*dmrmin*dmrmin*dmrmin*dmrmin)
108  cn0r_dmrmax=1./(pi*rhol*dmrmax*dmrmax*dmrmax*dmrmax)
109  if(me==0)print *,'MICROINIT: MDRmin, MASSR(MDRmin)=',mdrmin,massr(mdrmin)
110  if(me==0)print *,'MICROINIT: MDRmax, MASSR(MDRmax)=',mdrmax,massr(mdrmax)
111 ! print *, 'ETA2P:MASSI(50)= ', MASSI(50)
112 ! print *, 'ETA2P:MASSI(450)= ', MASSI(450)
113 ! print *, 'ETA2P:MASSI(1000)= ', MASSI(1000)
114 !
115 !--- Initialize saturation vapor pressure lookup tables (functions FPVS, FPVS0)
116 !
117  CALL gpvs
118 !
119 !--- Initialize RHgrd, grid-scale RH for onset of condensation.
120 ! See GSMCONST in Eta model for algorithm with grid-size dependence.
121 !
122 ! AX=111.*(DPHD**2+DLMD**2)**.5
123 ! AX=111.*(DYVAL/1000.**2+DXVAL/1000.**2)**.5
124 ! AX=MIN(100., MAX(5., AX) )
125 ! RHgrd=0.90+.08*((100.-AX)/95.)**.5
126  deallocate(massr)
127 !---
128  RETURN
129  END