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

Last change on this file since 415 was 401, checked in by dubos, 8 years ago

Introduced entropy as prognostic variable - tested with JW06
File size: 14.6 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
175      IF( TRIM(etat0_type)/='williamson91.6' ) CALL compute_temperature2entropy(ps,temp,q,theta_rhodz, 1)
176   
177    ENDDO
178   
179    CALL deallocate_field(f_temp)
180   
181  END SUBROUTINE etat0_collocated
182
183  SUBROUTINE compute_temperature2entropy(ps,temp,q,theta_rhodz,offset)
184    USE icosa
185    USE pression_mod
186    USE exner_mod
187    USE omp_para
188    IMPLICIT NONE
189    REAL(rstd),INTENT(IN)  :: ps(iim*jjm)
190    REAL(rstd),INTENT(IN)  :: temp(iim*jjm,llm)
191    REAL(rstd),INTENT(IN)  :: q(iim*jjm,llm,nqtot)
192    REAL(rstd),INTENT(OUT) :: theta_rhodz(iim*jjm,llm)
193    INTEGER,INTENT(IN) :: offset
194
195    REAL(rstd) :: p(iim*jjm,llm+1)
196    REAL(rstd) :: cppd,Rd, mass, p_ij, q_ij,r_ij, chi,nu, entropy, theta
197    INTEGER :: i,j,ij,l
198
199    cppd=cpp
200    Rd=kappa*cppd
201
202    CALL compute_pression(ps,p,offset)
203    ! flush p
204    !$OMP BARRIER
205    DO    l    = ll_begin, ll_end
206       DO j=jj_begin-offset,jj_end+offset
207          DO i=ii_begin-offset,ii_end+offset
208             ij=(j-1)*iim+i
209             mass = (p(ij,l)-p(ij,l+1))/g ! dry+moist mass
210             p_ij = .5*(p(ij,l)+p(ij,l+1))  ! pressure at full level
211             SELECT CASE(caldyn_thermo)
212             CASE(thermo_theta)
213                theta = temp(ij,l)*(p_ij/preff)**(-kappa) 
214                theta_rhodz(ij,l) = mass * theta
215             CASE(thermo_entropy)
216                nu = log(p_ij/preff)
217                chi = log(temp(ij,l)/Treff)
218                entropy = cppd*chi-Rd*nu
219                theta_rhodz(ij,l) = mass * entropy
220!             CASE(thermo_moist)
221!                q_ij=q(ij,l,1)
222!                r_ij=1.-q_ij
223!                mass=mass*(1-q_ij) ! dry mass
224!                nu = log(p_ij/preff)
225!                chi = log(temp(ij,l)/Treff)
226!                entropy = r_ij*(cppd*chi-Rd*nu) + q_ij*(cppv*chi-Rv*nu)
227!                theta_rhodz(ij,l) = mass * entropy               
228                CASE DEFAULT
229                   STOP
230             END SELECT
231          ENDDO
232       ENDDO
233    ENDDO
234    !$OMP BARRIER 
235  END SUBROUTINE compute_temperature2entropy
236
237  SUBROUTINE compute_etat0_collocated(ps,mass,phis,temp_i,u, geopot,W, q)
238    USE wind_mod
239    USE disvert_mod
240    USE etat0_jablonowsky06_mod, ONLY : compute_jablonowsky06 => compute_etat0
241    USE etat0_dcmip1_mod, ONLY : compute_dcmip1 => compute_etat0
242    USE etat0_dcmip2_mod, ONLY : compute_dcmip2 => compute_etat0
243    USE etat0_dcmip3_mod, ONLY : compute_dcmip3 => compute_etat0
244    USE etat0_dcmip4_mod, ONLY : compute_dcmip4 => compute_etat0
245    USE etat0_dcmip5_mod, ONLY : compute_dcmip5 => compute_etat0
246    USE etat0_bubble_mod, ONLY : compute_bubble => compute_etat0 
247    USE etat0_williamson_mod, ONLY : compute_w91_6 => compute_etat0
248    USE etat0_temperature_mod, ONLY: compute_etat0_temperature => compute_etat0
249    USE etat0_dcmip2016_baroclinic_wave_mod, ONLY : compute_dcmip2016_baroclinic_wave => compute_etat0
250    USE etat0_dcmip2016_cyclone_mod, ONLY : compute_dcmip2016_cyclone => compute_etat0
251    USE etat0_dcmip2016_supercell_mod, ONLY : compute_dcmip2016_supercell => compute_etat0
252    IMPLICIT NONE
253    REAL(rstd),INTENT(INOUT) :: ps(iim*jjm)
254    REAL(rstd),INTENT(INOUT) :: mass(iim*jjm,llm)
255    REAL(rstd),INTENT(OUT) :: phis(iim*jjm)
256    REAL(rstd),INTENT(OUT) :: temp_i(iim*jjm,llm)
257    REAL(rstd),INTENT(OUT) :: u(3*iim*jjm,llm)
258    REAL(rstd),INTENT(OUT) :: W(iim*jjm,llm+1)
259    REAL(rstd),INTENT(OUT) :: geopot(iim*jjm,llm+1)
260    REAL(rstd),INTENT(OUT) :: q(iim*jjm,llm,nqtot)
261
262    REAL(rstd) :: ulon_i(iim*jjm,llm)
263    REAL(rstd) :: ulat_i(iim*jjm,llm)
264
265    REAL(rstd) :: ps_e(3*iim*jjm)
266    REAL(rstd) :: mass_e(3*iim*jjm,llm)
267    REAL(rstd) :: phis_e(3*iim*jjm)
268    REAL(rstd) :: temp_e(3*iim*jjm,llm)
269    REAL(rstd) :: geopot_e(3*iim*jjm,llm+1)
270    REAL(rstd) :: ulon_e(3*iim*jjm,llm)
271    REAL(rstd) :: ulat_e(3*iim*jjm,llm)
272    REAL(rstd) :: q_e(3*iim*jjm,llm,nqtot)
273
274    INTEGER :: l,i,j,ij
275    REAL :: p_ik, v_ik, mass_ik
276    LOGICAL :: autoinit_mass, autoinit_NH
277
278    ! For NH geopotential and vertical momentum must be initialized.
279    ! Unless autoinit_NH is set to .FALSE. , they will be initialized
280    ! to hydrostatic geopotential and zero
281    autoinit_mass = .TRUE.
282    autoinit_NH = .NOT. hydrostatic
283    w(:,:) = 0
284
285    !$OMP BARRIER
286
287    SELECT CASE (TRIM(etat0_type))
288    CASE ('isothermal')
289       CALL compute_etat0_isothermal(iim*jjm, phis, ps, temp_i, ulon_i, ulat_i, q)
290       CALL compute_etat0_isothermal(3*iim*jjm, phis_e, ps_e, temp_e, ulon_e, ulat_e, q_e)
291    CASE ('temperature_profile')
292       CALL compute_etat0_temperature(iim*jjm, phis, ps, temp_i, ulon_i, ulat_i, q)
293       CALL compute_etat0_temperature(3*iim*jjm, phis_e, ps_e, temp_e, ulon_e, ulat_e, q_e)
294    CASE('jablonowsky06')
295       CALL compute_jablonowsky06(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i)
296       CALL compute_jablonowsky06(3*iim*jjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e)
297    CASE('dcmip1')
298       CALL compute_dcmip1(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i, q)
299       CALL compute_dcmip1(3*iim*jjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e, q_e)
300    CASE ('dcmip2_mountain','dcmip2_schaer_noshear','dcmip2_schaer_shear')
301       CALL compute_dcmip2(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i)
302       CALL compute_dcmip2(3*iim*jjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e)     
303    CASE('dcmip3')
304       CALL compute_dcmip3(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i, geopot, q)
305       CALL compute_dcmip3(3*iim*jjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e, geopot_e, q_e)
306       autoinit_NH = .FALSE. ! compute_dcmip3 initializes geopot
307    CASE('dcmip4')
308       CALL compute_dcmip4(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i, q)
309       CALL compute_dcmip4(3*iim*jjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e, q_e)
310    CASE('dcmip5')
311       CALL compute_dcmip5(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i, q)
312       CALL compute_dcmip5(3*iim*jjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e, q_e)
313    CASE('bubble')
314       CALL compute_bubble(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i, geopot, q)
315       CALL compute_bubble(3*iim*jjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e, geopot_e, q_e)
316!       autoinit_NH = .FALSE. ! compute_bubble initializes geopot
317    CASE('williamson91.6')
318       CALL compute_w91_6(iim*jjm,lon_i,lat_i, phis, mass(:,1), temp_i(:,1), ulon_i(:,1), ulat_i(:,1))
319       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))
320       autoinit_mass = .FALSE. ! do not overwrite mass
321    CASE('dcmip2016_baroclinic_wave')
322       CALL compute_dcmip2016_baroclinic_wave(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i, q)
323       CALL compute_dcmip2016_baroclinic_wave(3*iim*jjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e, q_e)
324    CASE('dcmip2016_cyclone')
325       CALL compute_dcmip2016_cyclone(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i, q)
326       CALL compute_dcmip2016_cyclone(3*iim*jjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e, q_e)
327    CASE('dcmip2016_supercell')
328       CALL compute_dcmip2016_supercell(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i, q)
329       CALL compute_dcmip2016_supercell(3*iim*jjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e, q_e)
330    END SELECT
331
332    IF(autoinit_mass) CALL compute_rhodz(.TRUE., ps, mass) ! initialize mass distribution using ps
333    IF(autoinit_NH) THEN
334       geopot(:,1) = phis(:) ! surface geopotential
335       DO l = 1, llm
336          DO ij=1,iim*jjm
337             ! hybrid pressure coordinate
338             p_ik = ptop + mass_ak(l) + mass_bk(l)*ps(ij)
339             mass_ik = (mass_dak(l) + mass_dbk(l)*ps(ij))/g
340             ! v=R.T/p, R=kappa*cpp
341             v_ik = kappa*cpp*temp_i(ij,l)/p_ik
342             geopot(ij,l+1) = geopot(ij,l) + mass_ik*v_ik*g
343          END DO
344       END DO
345    END IF
346
347    !$OMP BARRIER
348
349    CALL compute_wind_perp_from_lonlat_compound(ulon_e, ulat_e, u)
350
351  END SUBROUTINE compute_etat0_collocated
352
353!----------------------------- Resting isothermal state --------------------------------
354
355  SUBROUTINE getin_etat0_isothermal
356    etat0_temp=300
357    CALL getin("etat0_isothermal_temp",etat0_temp)
358  END SUBROUTINE getin_etat0_isothermal
359
360  SUBROUTINE compute_etat0_isothermal(ngrid, phis, ps, temp, ulon, ulat, q)
361    IMPLICIT NONE 
362    INTEGER, INTENT(IN)    :: ngrid
363    REAL(rstd),INTENT(OUT) :: phis(ngrid)
364    REAL(rstd),INTENT(OUT) :: ps(ngrid)
365    REAL(rstd),INTENT(OUT) :: temp(ngrid,llm)
366    REAL(rstd),INTENT(OUT) :: ulon(ngrid,llm)
367    REAL(rstd),INTENT(OUT) :: ulat(ngrid,llm)
368    REAL(rstd),INTENT(OUT) :: q(ngrid,llm,nqtot)
369    phis(:)=0
370    ps(:)=preff
371    temp(:,:)=etat0_temp
372    ulon(:,:)=0
373    ulat(:,:)=0
374    q(:,:,:)=0
375  END SUBROUTINE compute_etat0_isothermal
376
377END MODULE etat0_mod
Note: See TracBrowser for help on using the repository browser.