source: ICOSA_LMDZ/src/phylmd/icolmdz_etat0.f90 @ 5849

Last change on this file since 5849 was 5724, checked in by yann meurdesoif, 5 months ago

Due to dynamico module reorganization, some module imports were missing.
YM
  • Property svn:executable set to *
File size: 8.1 KB
Line 
1MODULE icolmdz_etat0
2
3
4CONTAINS
5
6  SUBROUTINE init_etat0
7      USE xios_mod
8      USE omp_para
9      USE getin_mod, ONLY: getin
10      IMPLICIT NONE
11      CHARACTER(LEN=256) :: etat0_lmdz
12
13      ! @getin_doc etat0_database_type realm=initial type=String default=`legacy`
14      !  When `etat0=="database"`, selects type of external file(s) from which initial state is read. Valid values :
15      !  * `legacy` : reads from XIOS group `read_files_legacy`, see `xml/context_dynamico.xml`
16      !  * `ERA5_forcing` : reads from XIOS group `read_files_ERA5_forcing`, see `xml/context_dynamico.xml`
17
18      etat0_lmdz = "legacy"
19      CALL getin("etat0_lmdz", etat0_lmdz)
20
21      IF (is_omp_master) THEN
22         CALL xios_set_fieldgroup_attr("read_fields", enabled=.TRUE.)
23         IF (TRIM(etat0_lmdz) == "legacy") THEN
24            CALL xios_set_filegroup_attr("read_files_legacy", enabled=.TRUE.)
25            CALL xios_set_field_attr("relief_db", field_ref="relief_db_legacy")
26            CALL xios_set_field_attr("ps_db", field_ref="ps_db_legacy")
27            CALL xios_set_field_attr("z_db", field_ref="z_db_legacy")
28            CALL xios_set_field_attr("ts_db", field_ref="ts_db_legacy")
29            CALL xios_set_field_attr("u_db", field_ref="u_db_legacy")
30            CALL xios_set_field_attr("v_db", field_ref="v_db_legacy")
31            CALL xios_set_field_attr("temp_db", field_ref="temp_db_legacy")
32            CALL xios_set_field_attr("q_db", field_ref="q_db_legacy")
33            IF (using_xios3) CALL xios_set_axis_attr("lev_ecdyn", axis_ref="u_db_legacy::")
34          ELSE IF (TRIM(etat0_lmdz) == "ERA5_forcing") THEN
35            CALL xios_set_filegroup_attr("read_files_ERA5_forcing", enabled=.TRUE.)
36            CALL xios_set_field_attr("relief_db", field_ref="relief_db_forcing")
37            CALL xios_set_field_attr("ps_db", field_ref="ps_db_forcing")
38            CALL xios_set_field_attr("z_db", field_ref="z_db_forcing")
39            CALL xios_set_field_attr("ts_db", field_ref="ts_db_forcing")
40            CALL xios_set_field_attr("u_db", field_ref="u_db_forcing")
41            CALL xios_set_field_attr("v_db", field_ref="v_db_forcing")
42            CALL xios_set_field_attr("temp_db", field_ref="temp_db_forcing")
43            CALL xios_set_field_attr("q_db", field_ref="q_db_forcing")
44            IF (using_xios3) CALL xios_set_axis_attr("lev_ecdyn", axis_ref="u_db_forcing::")
45         ELSE
46        PRINT*,"Bad selector for variable <etat0_lmdz> ",TRIM(etat0_lmdz), " option are <legacy> (default), <ERA5_forcing>"
47            STOP
48         END IF
49      END IF
50   END SUBROUTINE init_etat0
51
52
53   SUBROUTINE etat0(f_ps, f_phis, f_theta_rhodz, f_u, f_q)
54      USE icosa
55      USE restart_mod
56      USE wind_from_lonlat_mod
57      USE write_field_mod
58      USE time_mod
59      USE transfert_mod
60      USE xios_mod
61      USE write_field_mod
62      USE vertical_remap_mod
63      USE theta2theta_rhodz_mod
64      USE qsat_mod
65      USE pression_mod
66      USE omp_para
67      USE tracer_icosa_mod
68      USE earth_const, ONLY : g
69      IMPLICIT NONE
70      TYPE(t_field), POINTER :: f_ps(:)
71      TYPE(t_field), POINTER :: f_phis(:)
72      TYPE(t_field), POINTER :: f_theta_rhodz(:)
73      TYPE(t_field), POINTER :: f_u(:)
74      TYPE(t_field), POINTER :: f_q(:)
75
76      TYPE(t_field), POINTER, SAVE :: f_ulon_reg(:)
77      TYPE(t_field), POINTER, SAVE :: f_ulat_reg(:)
78      TYPE(t_field), POINTER, SAVE :: f_temp_reg(:)
79      TYPE(t_field), POINTER, SAVE :: f_q_reg(:)
80
81      TYPE(t_field), POINTER, SAVE :: f_ts(:)
82      TYPE(t_field), POINTER, SAVE :: f_z(:)
83      TYPE(t_field), POINTER, SAVE :: f_ulon(:)
84      TYPE(t_field), POINTER, SAVE :: f_ulat(:)
85      TYPE(t_field), POINTER, SAVE :: f_temp(:)
86      TYPE(t_field), POINTER, SAVE :: f_q1(:)
87      TYPE(t_field), POINTER, SAVE :: f_qsat(:)
88      TYPE(t_field), POINTER, SAVE :: f_p(:)
89      INTEGER :: nb_level
90      REAL, ALLOCATABLE:: levels(:)
91      INTEGER :: ind
92
93      CALL xios_read_field("relief_db", f_phis)
94
95      CALL writeField("relief_out", f_phis, once=.TRUE.)
96
97      IF (is_omp_level_master) THEN
98         DO ind = 1, ndomain
99            IF (.NOT. assigned_domain(ind)) CYCLE
100            f_phis(ind)%rval2d(:) = f_phis(ind)%rval2d(:)*g
101         END DO
102      END IF
103!$OMP BARRIER
104
105      IF (is_omp_master) CALL xios_get_axis_attr("lev_ecdyn", n_glo=nb_level)
106      CALL bcast_omp(nb_level)
107      ALLOCATE (levels(nb_level))
108
109      IF (is_omp_master) CALL xios_get_axis_attr("lev_ecdyn", value=levels)
110      CALL bcast_omp(levels)
111
112      levels = levels*100  ! hectoPascal -> Pascal
113
114      CALL allocate_field(f_ts, field_t, type_real, name="ts")
115      CALL allocate_field(f_z, field_t, type_real, name="z")
116      CALL allocate_field(f_ulon_reg, field_t, type_real, nb_level)
117      CALL allocate_field(f_ulat_reg, field_t, type_real, nb_level)
118      CALL allocate_field(f_temp_reg, field_t, type_real, nb_level)
119      CALL allocate_field(f_q_reg, field_t, type_real, nb_level)
120
121      CALL allocate_field(f_q1, field_t, type_real, llm)
122      CALL allocate_field(f_qsat, field_t, type_real, llm)
123      CALL allocate_field(f_p, field_t, type_real, llm + 1)
124      CALL allocate_field(f_temp, field_t, type_real, llm)
125      CALL allocate_field(f_ulon, field_t, type_real, llm)
126      CALL allocate_field(f_ulat, field_t, type_real, llm)
127
128      CALL xios_read_field("z_db", f_z)
129      CALL xios_read_field("ps_db", f_ps)
130      CALL xios_read_field("ts_db", f_ts)
131      CALL writeField("ps_out", f_ps)
132
133!$OMP BARRIER
134
135!    CALL writeField("phis_out",f_phis,once=.TRUE.)
136!    CALL writeField("ts_out",f_ts,once=.TRUE.)
137
138! make correction to ps due to relief at higher resolution
139! difference with LMDZ : tsol is taken from ECDYN.NC and not from ECPHY
140      IF (is_omp_level_master) THEN
141         DO ind = 1, ndomain
142            IF (.NOT. assigned_domain(ind)) CYCLE
143            f_ps(ind)%rval2d(:) = f_ps(ind)%rval2d(:)*(1.+(f_z(ind)%rval2d(:) - f_phis(ind)%rval2d(:))/287.0/f_ts(ind)%rval2d(:))
144         END DO
145      END IF
146!$OMP BARRIER
147      CALL transfert_request(f_ps, req_i0)
148      CALL writeField("ps_out", f_ps)
149
150      CALL xios_read_field("temp_db", f_temp_reg)
151      CALL vertical_remap(levels, f_temp_reg, f_ps, f_temp)
152      CALL transfert_request(f_temp, req_i0)
153      CALL temperature2theta_rhodz(f_ps, f_temp, f_theta_rhodz)
154
155      CALL xios_read_field("u_db", f_ulon_reg)
156      CALL vertical_remap(levels, f_ulon_reg, f_ps, f_ulon)
157      CALL xios_read_field("v_db", f_ulat_reg)
158      CALL vertical_remap(levels, f_ulat_reg, f_ps, f_ulat)
159      CALL transfert_request(f_ulat, req_i0)
160      CALL transfert_request(f_ulon, req_i0)
161      CALL ulonlat2un(f_ulon, f_ulat, f_u)
162
163      CALL xios_read_field("q_db", f_q_reg)
164      CALL vertical_remap(levels, f_q_reg, f_ps, f_q1)
165
166      CALL pression(f_ps, f_p)
167! difference with LMDZ : for qsat, pressure at mid layer is computed as a mean value pmid=(p(l)+p(l+1))/2
168      CALL qsat(f_temp, f_p, f_qsat)
169      CALL transfert_request(f_qsat, req_i0)
170
171      DO ind = 1, ndomain
172         IF (.NOT. assigned_domain(ind)) CYCLE
173
174         IF (tracers(2)%has_default_init_value) THEN
175            f_q(ind)%rval4d(:, :, 2) = tracers(2)%default_init_value
176         ELSE
177            f_q(ind)%rval4d(:, :, 2) = 1e-6
178         END IF
179         f_q(ind)%rval4d(:, :, 1) = f_q1(ind)%rval3d(:, :)*f_qsat(ind)%rval3d(:, :)*0.01
180         WHERE (f_q(ind)%rval4d(:, :, 1) < 0) f_q(ind)%rval4d(:, :, 1) = 0
181      END DO
182
183      tracers(1)%already_initialized = .TRUE.
184      tracers(2)%already_initialized = .TRUE.
185
186      CALL writeField("tempdb_out", f_temp_reg)
187      CALL writeField("temp_out", f_temp)
188
189      CALL deallocate_field(f_ts)
190      CALL deallocate_field(f_z)
191      CALL deallocate_field(f_ulon_reg)
192      CALL deallocate_field(f_ulat_reg)
193      CALL deallocate_field(f_temp_reg)
194      CALL deallocate_field(f_q_reg)
195
196      CALL deallocate_field(f_q1)
197      CALL deallocate_field(f_qsat)
198      CALL deallocate_field(f_p)
199      CALL deallocate_field(f_temp)
200      CALL deallocate_field(f_ulon)
201      CALL deallocate_field(f_ulat)
202
203   END SUBROUTINE etat0
204
205
206
207
208END MODULE icolmdz_etat0
Note: See TracBrowser for help on using the repository browser.