source: dynamico_lmdz/aquaplanet/ICOSAGCM/src/etat0_database.f90 @ 3927

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

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

YM
File size: 4.7 KB
Line 
1MODULE etat0_database_mod
2
3
4CONTAINS
5
6  SUBROUTINE init_etat0_database
7  USE xios
8  IMPLICIT NONE
9 
10    CALL xios_set_fieldgroup_attr("read_fields",enabled=.TRUE.)
11    CALL xios_set_filegroup_attr("read_files",enabled=.TRUE.)
12
13  END SUBROUTINE init_etat0_database
14
15  SUBROUTINE etat0(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
16  USE icosa
17  USE restart_mod
18  USE wind_mod
19  USE write_field_mod
20  USE time_mod
21  USE transfert_mod
22  USE xios_mod
23  USE write_field_mod
24  USE vertical_remap_mod
25  USE theta2theta_rhodz_mod
26  USE qsat_mod
27  USE pression_mod
28  USE omp_para
29  IMPLICIT NONE
30    TYPE(t_field),POINTER :: f_ps(:)
31    TYPE(t_field),POINTER :: f_phis(:)
32    TYPE(t_field),POINTER :: f_theta_rhodz(:)
33    TYPE(t_field),POINTER :: f_u(:)
34    TYPE(t_field),POINTER :: f_q(:)
35
36    TYPE(t_field),POINTER,SAVE :: f_ulon_reg(:)
37    TYPE(t_field),POINTER,SAVE :: f_ulat_reg(:)
38    TYPE(t_field),POINTER,SAVE :: f_temp_reg(:)
39    TYPE(t_field),POINTER,SAVE :: f_q_reg(:)
40
41    TYPE(t_field),POINTER,SAVE :: f_ts(:)
42    TYPE(t_field),POINTER,SAVE :: f_z(:)
43    TYPE(t_field),POINTER,SAVE :: f_ulon(:)
44    TYPE(t_field),POINTER,SAVE :: f_ulat(:)
45    TYPE(t_field),POINTER,SAVE :: f_temp(:)
46    TYPE(t_field),POINTER,SAVE :: f_q1(:)
47    TYPE(t_field),POINTER,SAVE :: f_qsat(:)
48    TYPE(t_field),POINTER,SAVE :: f_p(:)
49    INTEGER :: nb_level
50    REAL,ALLOCATABLE:: levels(:)
51    INTEGER :: ind
52
53    CALL xios_read_field("relief",f_phis)
54   
55    CALL writeField("relief_out",f_phis,once=.TRUE.)
56
57    DO ind=1,ndomain
58      IF (.NOT. assigned_domain(ind)) CYCLE
59      f_phis(ind)%rval2d(:)=f_phis(ind)%rval2d(:)*g     
60    ENDDO
61
62
63    IF (is_omp_master) CALL xios_get_axis_attr("lev_ecdyn",n_glo=nb_level)
64    CALL bcast_omp(nb_level)
65    ALLOCATE(levels(nb_level))
66
67    IF (is_omp_master) CALL xios_get_axis_attr("lev_ecdyn",value=levels)
68    CALL bcast_omp(levels)
69   
70    levels=levels*100  ! hectoPascal -> Pascal
71 
72    CALL allocate_field(f_ts, field_t, type_real, name="ts")
73    CALL allocate_field(f_z, field_t, type_real, name="z")
74    CALL allocate_field(f_ulon_reg, field_t, type_real,nb_level)
75    CALL allocate_field(f_ulat_reg, field_t, type_real,nb_level)
76    CALL allocate_field(f_temp_reg, field_t, type_real,nb_level)
77    CALL allocate_field(f_q_reg,    field_t, type_real,nb_level)
78   
79    CALL allocate_field(f_q1,    field_t, type_real,llm)
80    CALL allocate_field(f_qsat,  field_t, type_real,llm)
81    CALL allocate_field(f_p,  field_t, type_real,llm+1)
82    CALL allocate_field(f_temp,  field_t, type_real,llm)
83    CALL allocate_field(f_ulon,  field_t, type_real,llm)
84    CALL allocate_field(f_ulat,  field_t, type_real,llm)
85
86    CALL xios_read_field("z",f_z)
87    CALL xios_read_field("ps",f_ps)
88    CALL xios_read_field("ts",f_ts)
89    CALL writeField("ps_out",f_ps)
90
91!$OMP BARRIER
92   
93!    CALL writeField("phis_out",f_phis,once=.TRUE.)
94!    CALL writeField("ts_out",f_ts,once=.TRUE.)
95
96! make correction to ps due to relief at higher resolution
97! difference with LMDZ : tsol is taken from ECDYN.NC and not from ECPHY
98    DO ind=1,ndomain
99      IF (.NOT. assigned_domain(ind)) CYCLE
100      f_ps(ind)%rval2d(:)=f_ps(ind)%rval2d(:)*(1.+(f_z(ind)%rval2d(:)-f_phis(ind)%rval2d(:))/287.0/f_ts(ind)%rval2d(:))
101    ENDDO
102    CALL transfert_request(f_ps,req_i0)
103    CALL writeField("ps_out",f_ps)
104   
105   
106
107    CALL xios_read_field("temp",f_temp_reg)
108    CALL vertical_remap(levels,f_temp_reg,f_ps,f_temp)
109    CALL transfert_request(f_temp,req_i0)
110    CALL temperature2theta_rhodz(f_ps,f_temp,f_theta_rhodz)
111
112    CALL xios_read_field("u",f_ulon_reg)
113    CALL vertical_remap(levels,f_ulon_reg,f_ps,f_ulon)
114    CALL xios_read_field("v",f_ulat_reg)
115    CALL vertical_remap(levels,f_ulat_reg,f_ps,f_ulat)
116    CALL transfert_request(f_ulat,req_i0)
117    CALL transfert_request(f_ulon,req_i0)
118    CALL ulonlat2un(f_ulon, f_ulat,f_u)
119
120    CALL xios_read_field("q",f_q_reg)
121    CALL vertical_remap(levels,f_q_reg,f_ps,f_q1)
122
123    CALL pression(f_ps,f_p)
124! difference with LMDZ : for qsat, pressure at mid layer is computed as a mean value pmid=(p(l)+p(l+1))/2   
125    CALL qsat(f_temp,f_p,f_qsat)
126    CALL transfert_request(f_qsat,req_i0)
127
128    DO ind=1,ndomain
129      IF (.NOT. assigned_domain(ind)) CYCLE
130      f_q(ind)%rval4d(:,:,:)=0
131      f_q(ind)%rval4d(:,:,1)=f_q1(ind)%rval3d(:,:)*f_qsat(ind)%rval3d(:,:)*0.01
132      WHERE(f_q(ind)%rval4d(:,:,1)<0) f_q(ind)%rval4d(:,:,1)=0
133    ENDDO
134
135
136    CALL deallocate_field(f_ts)
137    CALL deallocate_field(f_z)
138    CALL deallocate_field(f_ulon_reg)
139    CALL deallocate_field(f_ulat_reg)
140    CALL deallocate_field(f_temp_reg)
141    CALL deallocate_field(f_q_reg)
142   
143    CALL deallocate_field(f_q1)
144    CALL deallocate_field(f_qsat)
145    CALL deallocate_field(f_p)
146    CALL deallocate_field(f_temp)
147    CALL deallocate_field(f_ulon)
148    CALL deallocate_field(f_ulat)   
149 
150  END SUBROUTINE etat0
151
152END MODULE etat0_database_mod
Note: See TracBrowser for help on using the repository browser.