source: codes/icosagcm/branches/SATURN_DYNAMICO/ICOSAGCM/src/etat0.f90 @ 268

Last change on this file since 268 was 268, checked in by millour, 10 years ago

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