source: codes/icosagcm/trunk/src/etat0.f90 @ 388

Last change on this file since 388 was 388, checked in by ymipsl, 8 years ago
  • Add dcmip2016 cyclone etat0 estcase
  • Add fisrt guess of dcmip2016 etat0 supercell testcase

YM
File size: 12.8 KB
Line 
1MODULE etat0_mod
2  USE icosa
3  IMPLICIT NONE         
4  PRIVATE
5
6    CHARACTER(len=255),SAVE :: etat0_type
7!$OMP THREADPRIVATE(etat0_type)
8
9    REAL(rstd) :: etat0_temp
10
11    PUBLIC :: etat0, etat0_type
12
13CONTAINS
14 
15  SUBROUTINE etat0(f_ps,f_mass,f_phis,f_theta_rhodz,f_u, f_geopot,f_w, f_q)
16    USE mpipara, ONLY : is_mpi_root
17    USE disvert_mod
18    ! Generic interface
19    USE etat0_dcmip1_mod, ONLY : getin_etat0_dcmip1=>getin_etat0
20    USE etat0_dcmip2_mod, ONLY : getin_etat0_dcmip2=>getin_etat0
21    USE etat0_dcmip4_mod, ONLY : getin_etat0_dcmip4=>getin_etat0
22    USE etat0_dcmip5_mod, ONLY : getin_etat0_dcmip5=>getin_etat0
23    USE etat0_bubble_mod, ONLY : getin_etat0_bubble=>getin_etat0
24    USE etat0_williamson_mod, ONLY : getin_etat0_williamson=>getin_etat0
25    USE etat0_temperature_mod, ONLY: getin_etat0_temperature=>getin_etat0
26    USE etat0_dcmip2016_baroclinic_wave_mod, ONLY : getin_etat0_dcmip2016_baroclinic_wave=>getin_etat0
27    USE etat0_dcmip2016_cyclone_mod, ONLY : getin_etat0_dcmip2016_cyclone=>getin_etat0
28    USE etat0_dcmip2016_supercell_mod, ONLY : getin_etat0_dcmip2016_supercell=>getin_etat0
29    ! Ad hoc interfaces
30    USE etat0_academic_mod, ONLY : etat0_academic=>etat0 
31    USE etat0_heldsz_mod, ONLY : etat0_heldsz=>etat0 
32    USE etat0_venus_mod,  ONLY : etat0_venus=>etat0 
33    USE etat0_start_file_mod, ONLY : etat0_start_file=>etat0 
34
35    IMPLICIT NONE
36    TYPE(t_field),POINTER :: f_ps(:)
37    TYPE(t_field),POINTER :: f_mass(:)
38    TYPE(t_field),POINTER :: f_phis(:)
39    TYPE(t_field),POINTER :: f_theta_rhodz(:)
40    TYPE(t_field),POINTER :: f_u(:)
41    TYPE(t_field),POINTER :: f_geopot(:)
42    TYPE(t_field),POINTER :: f_w(:)
43    TYPE(t_field),POINTER :: f_q(:)
44   
45    REAL(rstd),POINTER :: ps(:), mass(:,:)
46    LOGICAL :: autoinit_mass, autoinit_geopot, collocated
47    INTEGER :: ind,i,j,ij,l
48
49    ! most etat0 routines set ps and not mass
50    ! in that case and if caldyn_eta == eta_lag
51    ! the initial distribution of mass is taken to be the same
52    ! as what the mass coordinate would dictate
53    ! however if etat0_XXX defines mass then the flag autoinit_mass must be set to .FALSE.
54    ! otherwise mass will be overwritten
55    autoinit_mass = (caldyn_eta == eta_lag)
56
57    etat0_type='jablonowsky06'
58    CALL getin("etat0",etat0_type)
59   
60    !------------------- Generic interface ---------------------
61    collocated=.TRUE.
62    SELECT CASE (TRIM(etat0_type))
63    CASE ('isothermal')
64       CALL getin_etat0_isothermal
65    CASE ('temperature_profile')
66       CALL getin_etat0_temperature
67    CASE ('jablonowsky06')
68    CASE ('dcmip1')
69        CALL getin_etat0_dcmip1
70    CASE ('dcmip2_mountain','dcmip2_schaer_noshear','dcmip2_schaer_shear')
71       CALL getin_etat0_dcmip2
72    CASE ('dcmip3')
73    CASE ('dcmip4')
74        CALL getin_etat0_dcmip4
75    CASE ('dcmip5')
76        CALL getin_etat0_dcmip5
77    CASE ('bubble')
78        CALL getin_etat0_bubble
79    CASE ('williamson91.6')
80       autoinit_mass=.FALSE.
81       CALL getin_etat0_williamson
82    CASE ('dcmip2016_baroclinic_wave')
83        CALL getin_etat0_dcmip2016_baroclinic_wave
84    CASE ('dcmip2016_cyclone')
85        CALL getin_etat0_dcmip2016_cyclone
86    CASE ('dcmip2016_supercell')
87        CALL getin_etat0_dcmip2016_supercell
88    CASE DEFAULT
89       collocated=.FALSE.
90       autoinit_mass = .FALSE.
91    END SELECT
92
93    !------------------- Ad hoc interfaces --------------------
94    SELECT CASE (TRIM(etat0_type))
95    CASE ('start_file')
96       CALL etat0_start_file(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
97    CASE ('academic')
98       CALL etat0_academic(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
99    CASE ('held_suarez')
100       PRINT *,"Held & Suarez (1994) test case"
101       CALL etat0_heldsz(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
102    CASE ('venus')
103       CALL etat0_venus(f_ps, f_phis, f_theta_rhodz, f_u, f_q)
104       PRINT *, "Venus (Lebonnois et al., 2012) test case"
105   CASE DEFAULT
106      IF(collocated) THEN
107         CALL etat0_collocated(f_phis,f_ps,f_mass,f_theta_rhodz,f_u, f_geopot,f_W, f_q)
108      ELSE
109         PRINT*, 'Bad selector for variable etat0 <',etat0_type, &
110              '> options are <isothermal>, <temperature_profile>, <held_suarez>, &
111              &<bubble>, <venus>, <jablonowsky06>, <academic>, <dcmip[1-4]> '
112         STOP
113      END IF
114    END SELECT
115
116!       !$OMP BARRIER
117    IF(autoinit_mass) THEN
118       DO ind=1,ndomain
119          IF (.NOT. assigned_domain(ind)) CYCLE
120          CALL swap_dimensions(ind)
121          CALL swap_geometry(ind)
122          mass=f_mass(ind); ps=f_ps(ind)
123          CALL compute_rhodz(.TRUE., ps, mass) ! initialize mass distribution using ps
124       END DO
125    END IF
126 
127  END SUBROUTINE etat0
128
129  SUBROUTINE etat0_collocated(f_phis,f_ps,f_mass,f_theta_rhodz,f_u, f_geopot,f_W, f_q)
130    USE theta2theta_rhodz_mod
131    IMPLICIT NONE
132    TYPE(t_field),POINTER :: f_ps(:)
133    TYPE(t_field),POINTER :: f_mass(:)
134    TYPE(t_field),POINTER :: f_phis(:)
135    TYPE(t_field),POINTER :: f_theta_rhodz(:)
136    TYPE(t_field),POINTER :: f_u(:)
137    TYPE(t_field),POINTER :: f_geopot(:)
138    TYPE(t_field),POINTER :: f_W(:)
139    TYPE(t_field),POINTER :: f_q(:)
140 
141    TYPE(t_field),POINTER,SAVE :: f_temp(:)
142    REAL(rstd),POINTER :: ps(:)
143    REAL(rstd),POINTER :: mass(:,:)
144    REAL(rstd),POINTER :: phis(:)
145    REAL(rstd),POINTER :: theta_rhodz(:,:,:)
146    REAL(rstd),POINTER :: temp(:,:)
147    REAL(rstd),POINTER :: u(:,:)
148    REAL(rstd),POINTER :: geopot(:,:)
149    REAL(rstd),POINTER :: W(:,:)
150    REAL(rstd),POINTER :: q(:,:,:)
151    INTEGER :: ind
152
153    CALL allocate_field(f_temp,field_t,type_real,llm,name='temp')
154
155    DO ind=1,ndomain
156      IF (.NOT. assigned_domain(ind)) CYCLE
157      CALL swap_dimensions(ind)
158      CALL swap_geometry(ind)
159      ps=f_ps(ind)
160      mass=f_mass(ind)
161      phis=f_phis(ind)
162      theta_rhodz=f_theta_rhodz(ind)
163      temp=f_temp(ind)
164      u=f_u(ind)
165      geopot=f_geopot(ind)
166      w=f_w(ind)
167      q=f_q(ind)
168
169      IF( TRIM(etat0_type)=='williamson91.6' ) THEN
170         CALL compute_etat0_collocated(ps,mass, phis, theta_rhodz(:,:,1), u, geopot, W, q)
171      ELSE
172         CALL compute_etat0_collocated(ps,mass, phis, temp, u, geopot, W, q)
173      ENDIF
174    ENDDO
175   
176    IF( TRIM(etat0_type)/='williamson91.6' ) CALL temperature2theta_rhodz(f_ps,f_temp,f_theta_rhodz)
177   
178    CALL deallocate_field(f_temp)
179   
180  END SUBROUTINE etat0_collocated
181
182  SUBROUTINE compute_etat0_collocated(ps,mass,phis,temp_i,u, geopot,W, q)
183    USE wind_mod
184    USE disvert_mod
185    USE etat0_jablonowsky06_mod, ONLY : compute_jablonowsky06 => compute_etat0
186    USE etat0_dcmip1_mod, ONLY : compute_dcmip1 => compute_etat0
187    USE etat0_dcmip2_mod, ONLY : compute_dcmip2 => compute_etat0
188    USE etat0_dcmip3_mod, ONLY : compute_dcmip3 => compute_etat0
189    USE etat0_dcmip4_mod, ONLY : compute_dcmip4 => compute_etat0
190    USE etat0_dcmip5_mod, ONLY : compute_dcmip5 => compute_etat0
191    USE etat0_bubble_mod, ONLY : compute_bubble => compute_etat0 
192    USE etat0_williamson_mod, ONLY : compute_w91_6 => compute_etat0
193    USE etat0_temperature_mod, ONLY: compute_etat0_temperature => compute_etat0
194    USE etat0_dcmip2016_baroclinic_wave_mod, ONLY : compute_dcmip2016_baroclinic_wave => compute_etat0
195    USE etat0_dcmip2016_cyclone_mod, ONLY : compute_dcmip2016_cyclone => compute_etat0
196    USE etat0_dcmip2016_supercell_mod, ONLY : compute_dcmip2016_supercell => compute_etat0
197    IMPLICIT NONE
198    REAL(rstd),INTENT(INOUT) :: ps(iim*jjm)
199    REAL(rstd),INTENT(INOUT) :: mass(iim*jjm,llm)
200    REAL(rstd),INTENT(OUT) :: phis(iim*jjm)
201    REAL(rstd),INTENT(OUT) :: temp_i(iim*jjm,llm)
202    REAL(rstd),INTENT(OUT) :: u(3*iim*jjm,llm)
203    REAL(rstd),INTENT(OUT) :: W(iim*jjm,llm+1)
204    REAL(rstd),INTENT(OUT) :: geopot(iim*jjm,llm+1)
205    REAL(rstd),INTENT(OUT) :: q(iim*jjm,llm,nqtot)
206
207    REAL(rstd) :: ulon_i(iim*jjm,llm)
208    REAL(rstd) :: ulat_i(iim*jjm,llm)
209
210    REAL(rstd) :: ps_e(3*iim*jjm)
211    REAL(rstd) :: mass_e(3*iim*jjm,llm)
212    REAL(rstd) :: phis_e(3*iim*jjm)
213    REAL(rstd) :: temp_e(3*iim*jjm,llm)
214    REAL(rstd) :: geopot_e(3*iim*jjm,llm+1)
215    REAL(rstd) :: ulon_e(3*iim*jjm,llm)
216    REAL(rstd) :: ulat_e(3*iim*jjm,llm)
217    REAL(rstd) :: q_e(3*iim*jjm,llm,nqtot)
218
219    INTEGER :: l,i,j,ij
220    REAL :: p_ik, v_ik, mass_ik
221    LOGICAL :: autoinit_mass, autoinit_NH
222
223    ! For NH geopotential and vertical momentum must be initialized.
224    ! Unless autoinit_NH is set to .FALSE. , they will be initialized
225    ! to hydrostatic geopotential and zero
226    autoinit_mass = .TRUE.
227    autoinit_NH = .NOT. hydrostatic
228    w(:,:) = 0
229
230    !$OMP BARRIER
231
232    SELECT CASE (TRIM(etat0_type))
233    CASE ('isothermal')
234       CALL compute_etat0_isothermal(iim*jjm, phis, ps, temp_i, ulon_i, ulat_i, q)
235       CALL compute_etat0_isothermal(3*iim*jjm, phis_e, ps_e, temp_e, ulon_e, ulat_e, q_e)
236    CASE ('temperature_profile')
237       CALL compute_etat0_temperature(iim*jjm, phis, ps, temp_i, ulon_i, ulat_i, q)
238       CALL compute_etat0_temperature(3*iim*jjm, phis_e, ps_e, temp_e, ulon_e, ulat_e, q_e)
239    CASE('jablonowsky06')
240       CALL compute_jablonowsky06(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i)
241       CALL compute_jablonowsky06(3*iim*jjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e)
242    CASE('dcmip1')
243       CALL compute_dcmip1(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i, q)
244       CALL compute_dcmip1(3*iim*jjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e, q_e)
245    CASE ('dcmip2_mountain','dcmip2_schaer_noshear','dcmip2_schaer_shear')
246       CALL compute_dcmip2(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i)
247       CALL compute_dcmip2(3*iim*jjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e)     
248    CASE('dcmip3')
249       CALL compute_dcmip3(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i, geopot, q)
250       CALL compute_dcmip3(3*iim*jjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e, geopot_e, q_e)
251       autoinit_NH = .FALSE. ! compute_dcmip3 initializes geopot
252    CASE('dcmip4')
253       CALL compute_dcmip4(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i, q)
254       CALL compute_dcmip4(3*iim*jjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e, q_e)
255    CASE('dcmip5')
256       CALL compute_dcmip5(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i, q)
257       CALL compute_dcmip5(3*iim*jjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e, q_e)
258    CASE('bubble')
259       CALL compute_bubble(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i, geopot, q)
260       CALL compute_bubble(3*iim*jjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e, geopot_e, q_e)
261!       autoinit_NH = .FALSE. ! compute_bubble initializes geopot
262    CASE('williamson91.6')
263       CALL compute_w91_6(iim*jjm,lon_i,lat_i, phis, mass(:,1), temp_i(:,1), ulon_i(:,1), ulat_i(:,1))
264       CALL compute_w91_6(3*iim*jjm,lon_e,lat_e, phis_e, mass_e(:,1), temp_e(:,1), ulon_e(:,1), ulat_e(:,1))
265       autoinit_mass = .FALSE. ! do not overwrite mass
266    CASE('dcmip2016_baroclinic_wave')
267       CALL compute_dcmip2016_baroclinic_wave(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i, q)
268       CALL compute_dcmip2016_baroclinic_wave(3*iim*jjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e, q_e)
269    CASE('dcmip2016_cyclone')
270       CALL compute_dcmip2016_cyclone(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i, q)
271       CALL compute_dcmip2016_cyclone(3*iim*jjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e, q_e)
272    CASE('dcmip2016_supercell')
273       CALL compute_dcmip2016_supercell(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i, q)
274       CALL compute_dcmip2016_supercell(3*iim*jjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e, q_e)
275    END SELECT
276
277    IF(autoinit_mass) CALL compute_rhodz(.TRUE., ps, mass) ! initialize mass distribution using ps
278    IF(autoinit_NH) THEN
279       geopot(:,1) = phis(:) ! surface geopotential
280       DO l = 1, llm
281          DO ij=1,iim*jjm
282             ! hybrid pressure coordinate
283             p_ik = ptop + mass_ak(l) + mass_bk(l)*ps(ij)
284             mass_ik = (mass_dak(l) + mass_dbk(l)*ps(ij))/g
285             ! v=R.T/p, R=kappa*cpp
286             v_ik = kappa*cpp*temp_i(ij,l)/p_ik
287             geopot(ij,l+1) = geopot(ij,l) + mass_ik*v_ik*g
288          END DO
289       END DO
290    END IF
291
292    !$OMP BARRIER
293
294    CALL compute_wind_perp_from_lonlat_compound(ulon_e, ulat_e, u)
295
296  END SUBROUTINE compute_etat0_collocated
297
298!----------------------------- Resting isothermal state --------------------------------
299
300  SUBROUTINE getin_etat0_isothermal
301    etat0_temp=300
302    CALL getin("etat0_isothermal_temp",etat0_temp)
303  END SUBROUTINE getin_etat0_isothermal
304
305  SUBROUTINE compute_etat0_isothermal(ngrid, phis, ps, temp, ulon, ulat, q)
306    IMPLICIT NONE 
307    INTEGER, INTENT(IN)    :: ngrid
308    REAL(rstd),INTENT(OUT) :: phis(ngrid)
309    REAL(rstd),INTENT(OUT) :: ps(ngrid)
310    REAL(rstd),INTENT(OUT) :: temp(ngrid,llm)
311    REAL(rstd),INTENT(OUT) :: ulon(ngrid,llm)
312    REAL(rstd),INTENT(OUT) :: ulat(ngrid,llm)
313    REAL(rstd),INTENT(OUT) :: q(ngrid,llm,nqtot)
314    phis(:)=0
315    ps(:)=preff
316    temp(:,:)=etat0_temp
317    ulon(:,:)=0
318    ulat(:,:)=0
319    q(:,:,:)=0
320  END SUBROUTINE compute_etat0_isothermal
321
322END MODULE etat0_mod
Note: See TracBrowser for help on using the repository browser.