source: dynamico_lmdz/aquaplanet/ICOSAGCM/src/etat0.f90 @ 3914

Last change on this file since 3914 was 3914, checked in by ymipsl, 9 years ago

Restart file in dynamico is generated after each start, at timestep 0.

YM
File size: 9.5 KB
Line 
1MODULE etat0_mod
2  USE icosa
3  PRIVATE
4
5    CHARACTER(len=255),SAVE :: etat0_type
6!$OMP THREADPRIVATE(etat0_type)
7
8    REAL(rstd) :: etat0_temp
9
10    PUBLIC :: etat0, init_etat0, etat0_type
11
12CONTAINS
13
14  SUBROUTINE Init_etat0
15  USE etat0_database_mod
16  IMPLICIT NONE
17
18    CALL getin("etat0",etat0_type)
19
20    SELECT CASE (TRIM(etat0_type))
21      CASE ('isothermal')
22      CASE ('temperature_profile')
23      CASE ('jablonowsky06')
24      CASE ('dcmip5')
25      CASE ('williamson91.6')
26      CASE ('start_file')
27      CASE ('database')
28        CALL init_etat0_database
29      CASE ('academic')
30      CASE ('held_suarez')
31      CASE ('venus')
32      CASE ('dcmip1')
33      CASE ('dcmip2_mountain','dcmip2_schaer_noshear','dcmip2_schaer_shear')
34      CASE ('dcmip3')
35      CASE ('dcmip4')
36      CASE DEFAULT
37         PRINT*, 'Bad selector for variable etat0 <',etat0_type, &
38            '> options are <jablonowsky06>, <academic>, <dcmip[1-4]> '
39         STOP
40    END SELECT
41 
42  END SUBROUTINE Init_etat0
43 
44  SUBROUTINE etat0(f_ps,f_mass,f_phis,f_theta_rhodz,f_u, f_q)
45    USE mpipara, ONLY : is_mpi_root
46    USE disvert_mod
47    ! New interface
48    USE etat0_dcmip5_mod, ONLY : getin_etat0_dcmip5=>getin_etat0
49    USE etat0_williamson_mod, ONLY : getin_etat0_williamson=>getin_etat0
50    USE etat0_temperature_mod, ONLY: getin_etat0_temperature=>getin_etat0
51    ! Old interface
52    USE etat0_academic_mod, ONLY : etat0_academic=>etat0 
53    USE etat0_dcmip1_mod, ONLY : etat0_dcmip1=>etat0
54    USE etat0_dcmip2_mod, ONLY : etat0_dcmip2=>etat0
55    USE etat0_dcmip3_mod, ONLY : etat0_dcmip3=>etat0 
56    USE etat0_dcmip4_mod, ONLY : etat0_dcmip4=>etat0 
57    USE etat0_heldsz_mod, ONLY : etat0_heldsz=>etat0 
58    USE etat0_venus_mod,  ONLY : etat0_venus=>etat0 
59    USE etat0_start_file_mod, ONLY : etat0_start_file=>etat0 
60    USE etat0_database_mod, ONLY : etat0_database=>etat0 
61    USE write_etat0_mod
62
63    IMPLICIT NONE
64    TYPE(t_field),POINTER :: f_ps(:)
65    TYPE(t_field),POINTER :: f_mass(:)
66    TYPE(t_field),POINTER :: f_phis(:)
67    TYPE(t_field),POINTER :: f_theta_rhodz(:)
68    TYPE(t_field),POINTER :: f_u(:)
69    TYPE(t_field),POINTER :: f_q(:)
70   
71    REAL(rstd),POINTER :: ps(:), mass(:,:)
72    LOGICAL :: init_mass
73    INTEGER :: ind,i,j,ij,l
74
75    ! most etat0 routines set ps and not mass
76    ! in that case and if caldyn_eta == eta_lag
77    ! the initial distribution of mass is taken to be the same
78    ! as what the mass coordinate would dictate
79    ! however if etat0_XXX defines mass then the flag init_mass must be set to .FALSE.
80    ! otherwise mass will be overwritten
81    init_mass = (caldyn_eta == eta_lag)
82
83    etat0_type='jablonowsky06'
84    CALL getin("etat0",etat0_type)
85   
86    SELECT CASE (TRIM(etat0_type))
87       !------------------- New interface ---------------------
88    CASE ('isothermal')
89       CALL getin_etat0_isothermal
90       CALL etat0_collocated(f_phis,f_ps,f_mass,f_theta_rhodz,f_u, f_q)
91    CASE ('temperature_profile')
92       CALL getin_etat0_temperature
93       CALL etat0_collocated(f_phis,f_ps,f_mass,f_theta_rhodz,f_u, f_q)
94    CASE ('jablonowsky06')
95       CALL etat0_collocated(f_phis,f_ps,f_mass,f_theta_rhodz,f_u, f_q)
96     CASE ('dcmip5')
97        CALL getin_etat0_dcmip5
98        CALL etat0_collocated(f_phis,f_ps,f_mass,f_theta_rhodz,f_u, f_q)
99    CASE ('williamson91.6')
100       init_mass=.FALSE.
101       CALL getin_etat0_williamson
102       CALL etat0_collocated(f_phis,f_ps,f_mass,f_theta_rhodz,f_u, f_q)
103       !------------------- Old interface --------------------
104    CASE ('start_file')
105       CALL etat0_start_file(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
106    CASE ('database')
107       CALL etat0_database(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
108    CASE ('academic')
109       CALL etat0_academic(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
110    CASE ('held_suarez')
111       PRINT *,"Held & Suarez (1994) test case"
112       CALL etat0_heldsz(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
113    CASE ('venus')
114       CALL etat0_venus(f_ps, f_phis, f_theta_rhodz, f_u, f_q)
115       PRINT *, "Venus (Lebonnois et al., 2012) test case"
116    CASE ('dcmip1')
117       CALL etat0_dcmip1(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
118    CASE ('dcmip2_mountain','dcmip2_schaer_noshear','dcmip2_schaer_shear')
119       CALL etat0_dcmip2(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
120    CASE ('dcmip3')
121       CALL etat0_dcmip3(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
122    CASE ('dcmip4')
123        IF(nqtot<2) THEN
124           IF (is_mpi_root)  THEN
125              PRINT *, "nqtot must be at least 2 for test case DCMIP4"
126           END IF
127           STOP
128        END IF
129        CALL etat0_dcmip4(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
130   CASE DEFAULT
131       PRINT*, 'Bad selector for variable etat0 <',etat0_type, &
132            '> options are <jablonowsky06>, <academic>, <dcmip[1-4]> '
133       STOP
134    END SELECT
135
136    IF(init_mass) THEN ! initialize mass distribution using ps
137!       !$OMP BARRIER
138       DO ind=1,ndomain
139          IF (.NOT. assigned_domain(ind)) CYCLE
140          CALL swap_dimensions(ind)
141          CALL swap_geometry(ind)
142          mass=f_mass(ind); ps=f_ps(ind)
143          CALL compute_rhodz(.TRUE., ps, mass)
144       END DO
145    END IF
146
147    CALL write_etat0(0,f_ps,f_phis,f_theta_rhodz,f_u, f_q)
148
149  END SUBROUTINE etat0
150
151  SUBROUTINE etat0_collocated(f_phis,f_ps,f_mass,f_theta_rhodz,f_u, f_q)
152    USE theta2theta_rhodz_mod
153    IMPLICIT NONE
154    TYPE(t_field),POINTER :: f_ps(:)
155    TYPE(t_field),POINTER :: f_mass(:)
156    TYPE(t_field),POINTER :: f_phis(:)
157    TYPE(t_field),POINTER :: f_theta_rhodz(:)
158    TYPE(t_field),POINTER :: f_u(:)
159    TYPE(t_field),POINTER :: f_q(:)
160 
161    TYPE(t_field),POINTER,SAVE :: f_temp(:)
162    REAL(rstd),POINTER :: ps(:)
163    REAL(rstd),POINTER :: mass(:,:)
164    REAL(rstd),POINTER :: phis(:)
165    REAL(rstd),POINTER :: theta_rhodz(:,:)
166    REAL(rstd),POINTER :: temp(:,:)
167    REAL(rstd),POINTER :: u(:,:)
168    REAL(rstd),POINTER :: q(:,:,:)
169    INTEGER :: ind
170
171    CALL allocate_field(f_temp,field_t,type_real,llm,name='temp')
172
173    DO ind=1,ndomain
174      IF (.NOT. assigned_domain(ind)) CYCLE
175      CALL swap_dimensions(ind)
176      CALL swap_geometry(ind)
177      ps=f_ps(ind)
178      mass=f_mass(ind)
179      phis=f_phis(ind)
180      theta_rhodz=f_theta_rhodz(ind)
181      temp=f_temp(ind)
182      u=f_u(ind)
183      q=f_q(ind)
184
185      IF( TRIM(etat0_type)=='williamson91.6' ) THEN
186       CALL compute_etat0_collocated(ps,mass, phis, theta_rhodz, u, q)
187      ELSE
188       CALL compute_etat0_collocated(ps,mass, phis, temp, u, q)
189      ENDIF
190    ENDDO
191   
192    IF( TRIM(etat0_type)/='williamson91.6' ) CALL temperature2theta_rhodz(f_ps,f_temp,f_theta_rhodz)
193   
194    CALL deallocate_field(f_temp)
195   
196  END SUBROUTINE etat0_collocated
197
198  SUBROUTINE compute_etat0_collocated(ps,mass, phis, temp_i, u, q)
199    USE wind_mod
200    USE etat0_jablonowsky06_mod, ONLY : compute_jablonowsky06 => compute_etat0
201    USE etat0_dcmip5_mod, ONLY : compute_dcmip5 => compute_etat0
202    USE etat0_williamson_mod, ONLY : compute_w91_6 => compute_etat0
203    USE etat0_temperature_mod, ONLY: compute_etat0_temperature => compute_etat0
204    IMPLICIT NONE
205    REAL(rstd),INTENT(INOUT) :: ps(iim*jjm)
206    REAL(rstd),INTENT(INOUT) :: mass(iim*jjm,llm)
207    REAL(rstd),INTENT(OUT) :: phis(iim*jjm)
208    REAL(rstd),INTENT(OUT) :: temp_i(iim*jjm,llm)
209    REAL(rstd),INTENT(OUT) :: u(3*iim*jjm,llm)
210    REAL(rstd),INTENT(OUT) :: q(iim*jjm,llm,nqtot)
211
212    REAL(rstd) :: ulon_i(iim*jjm,llm)
213    REAL(rstd) :: ulat_i(iim*jjm,llm)
214
215    REAL(rstd) :: ps_e(3*iim*jjm)
216    REAL(rstd) :: mass_e(3*iim*jjm,llm)
217    REAL(rstd) :: phis_e(3*iim*jjm)
218    REAL(rstd) :: temp_e(3*iim*jjm,llm)
219    REAL(rstd) :: ulon_e(3*iim*jjm,llm)
220    REAL(rstd) :: ulat_e(3*iim*jjm,llm)
221    REAL(rstd) :: q_e(3*iim*jjm,llm,nqtot)
222
223    INTEGER :: l,i,j,ij
224
225    SELECT CASE (TRIM(etat0_type))
226    CASE ('isothermal')
227       CALL compute_etat0_isothermal(iim*jjm, phis, ps, temp_i, ulon_i, ulat_i, q)
228       CALL compute_etat0_isothermal(3*iim*jjm, phis_e, ps_e, temp_e, ulon_e, ulat_e, q_e)
229    CASE ('temperature_profile')
230       CALL compute_etat0_temperature(iim*jjm, phis, ps, temp_i, ulon_i, ulat_i, q)
231       CALL compute_etat0_temperature(3*iim*jjm, phis_e, ps_e, temp_e, ulon_e, ulat_e, q_e)
232    CASE('jablonowsky06')
233       CALL compute_jablonowsky06(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i)
234       CALL compute_jablonowsky06(3*iim*jjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e)
235    CASE('dcmip5')
236       CALL compute_dcmip5(iim*jjm,lon_i,lat_i, phis, ps, temp_i, ulon_i, ulat_i, q)
237       CALL compute_dcmip5(3*iim*jjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e, q_e)
238    CASE('williamson91.6')
239       CALL compute_w91_6(iim*jjm,lon_i,lat_i, phis, mass(:,1), temp_i(:,1), ulon_i(:,1), ulat_i(:,1))
240       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))
241    END SELECT
242
243    CALL compute_wind_perp_from_lonlat_compound(ulon_e, ulat_e, u)
244
245  END SUBROUTINE compute_etat0_collocated
246
247!----------------------------- Resting isothermal state --------------------------------
248
249  SUBROUTINE getin_etat0_isothermal
250    etat0_temp=300
251    CALL getin("etat0_isothermal_temp",etat0_temp)
252  END SUBROUTINE getin_etat0_isothermal
253
254  SUBROUTINE compute_etat0_isothermal(ngrid, phis, ps, temp, ulon, ulat, q)
255    IMPLICIT NONE 
256    INTEGER, INTENT(IN)    :: ngrid
257    REAL(rstd),INTENT(OUT) :: phis(ngrid)
258    REAL(rstd),INTENT(OUT) :: ps(ngrid)
259    REAL(rstd),INTENT(OUT) :: temp(ngrid,llm)
260    REAL(rstd),INTENT(OUT) :: ulon(ngrid,llm)
261    REAL(rstd),INTENT(OUT) :: ulat(ngrid,llm)
262    REAL(rstd),INTENT(OUT) :: q(ngrid,llm,nqtot)
263    phis(:)=0
264    ps(:)=preff
265    temp(:,:)=etat0_temp
266    ulon(:,:)=0
267    ulat(:,:)=0
268    q(:,:,:)=0
269  END SUBROUTINE compute_etat0_isothermal
270
271END MODULE etat0_mod
Note: See TracBrowser for help on using the repository browser.