source: LMDZ6/trunk/libf/phylmd/create_etat0_unstruct_mod.f90

Last change on this file was 5776, checked in by evignon, 4 weeks ago

ajout de l'advection horizontale de la TKE. Travaux dans le cadre de la these de Valentin Wiener
File size: 10.4 KB
Line 
1MODULE create_etat0_unstruct_mod
2
3  REAL, SAVE, ALLOCATABLE :: zmea_gw(:)
4  !$OMP THREADPRIVATE(zmea_gw)
5  REAL, SAVE, ALLOCATABLE :: zpic_gw(:)
6  !$OMP THREADPRIVATE(zpic_gw)
7  REAL, SAVE, ALLOCATABLE :: zval_gw(:)
8  !$OMP THREADPRIVATE(zval_gw)
9  REAL, SAVE, ALLOCATABLE :: zstd_gw(:)
10  !$OMP THREADPRIVATE(zstd_gw)
11  REAL, SAVE, ALLOCATABLE :: zsig_gw(:)
12  !$OMP THREADPRIVATE(zsig_gw)
13  REAL, SAVE, ALLOCATABLE :: zgam_gw(:)
14  !$OMP THREADPRIVATE(zgam_gw)
15  REAL, SAVE, ALLOCATABLE :: zthe_gw(:)
16  !$OMP THREADPRIVATE(zthe_gw)
17
18  PRIVATE zmea_gw, zpic_gw, zval_gw, zstd_gw, zsig_gw, zgam_gw, zthe_gw
19
20
21CONTAINS
22 
23  SUBROUTINE init_create_etat0_unstruct
24  USE lmdz_xios
25  USE netcdf
26  USE mod_phys_lmdz_para
27  IMPLICIT NONE
28  INTEGER :: file_id, iret
29
30   ! for coupling activate ocean fraction reading from file "ocean_fraction.nc"
31    IF (is_omp_master) THEN
32
33      IF (NF90_OPEN("ocean_fraction.nc", NF90_NOWRITE, file_id)==NF90_NOERR) THEN
34        CALL xios_set_file_attr("relief",enabled=.FALSE.)
35        CALL xios_set_file_attr("frac_ocean",enabled=.TRUE.)
36        CALL xios_set_field_attr("mask",field_ref="frac_ocean_read")
37        iret=NF90_CLOSE(file_id)
38      ELSE IF (NF90_OPEN("land_water_0.05.nc", NF90_NOWRITE, file_id)==NF90_NOERR) THEN
39        CALL xios_set_file_attr("relief",enabled=.FALSE.)
40        CALL xios_set_file_attr("land_water",name="land_water_0.05",enabled=.TRUE.)
41        CALL xios_set_field_attr("mask",field_ref="land_water")
42        iret=NF90_CLOSE(file_id)
43      ELSE IF (NF90_OPEN("land_water_0.25.nc", NF90_NOWRITE, file_id)==NF90_NOERR) THEN
44        CALL xios_set_file_attr("relief",enabled=.FALSE.)
45        CALL xios_set_file_attr("land_water",name="land_water_0.25",enabled=.TRUE.)
46        CALL xios_set_field_attr("mask",field_ref="land_water")
47        iret=NF90_CLOSE(file_id)
48      ELSE IF (NF90_OPEN("land_water_0.50.nc", NF90_NOWRITE, file_id)==NF90_NOERR) THEN
49        CALL xios_set_file_attr("relief",enabled=.FALSE.)
50        CALL xios_set_file_attr("land_water",name="land_water_0.50",enabled=.TRUE.)
51        CALL xios_set_field_attr("mask",field_ref="land_water")
52        iret=NF90_CLOSE(file_id)
53      ENDIF
54
55    ENDIF
56
57  END SUBROUTINE init_create_etat0_unstruct
58
59
60  SUBROUTINE init_param_gw(zmea, zpic, zval, zstd, zsig, zgam, zthe)
61  USE dimphy
62    REAL, INTENT(IN) :: zmea(klon)
63    REAL, INTENT(IN) :: zpic(klon)
64    REAL, INTENT(IN) :: zval(klon)
65    REAL, INTENT(IN) :: zstd(klon)
66    REAL, INTENT(IN) :: zsig(klon)
67    REAL, INTENT(IN) :: zgam(klon)
68    REAL, INTENT(IN) :: zthe(klon)
69
70    ALLOCATE(zmea_gw(klon), zpic_gw(klon), zval_gw(klon), zstd_gw(klon), zsig_gw(klon), zgam_gw(klon), zthe_gw(klon))
71
72    zmea_gw(:)=zmea(:)
73    zpic_gw(:)=zpic(:)
74    zval_gw(:)=zval(:)
75    zstd_gw(:)=zstd(:)
76    zsig_gw(:)=zsig(:)
77    zgam_gw(:)=zgam(:)
78    zthe_gw(:)=zthe(:)
79
80  END SUBROUTINE init_param_gw
81
82
83
84
85  SUBROUTINE create_etat0_unstruct
86  USE dimphy
87  USE lmdz_xios
88  USE infotrac_phy
89  USE fonte_neige_mod
90  USE pbl_surface_mod
91  USE phys_state_var_mod
92  USE indice_sol_mod
93  USE surface_data,      ONLY: landice_opt
94  USE mod_phys_lmdz_para
95  USE print_control_mod, ONLY: lunout
96  USE geometry_mod
97  USE ioipsl_getin_p_mod, ONLY: getin_p
98  USE dimsoil_mod_h, ONLY: nsoilmx
99  USE clesphys_mod_h
100  USE alpale_mod
101  USE compbl_mod_h
102  IMPLICIT NONE
103
104    LOGICAL :: no_ter_antartique   ! If true, no land points are allowed at Antartic
105    REAL,    DIMENSION(klon)                 :: tsol
106    REAL,    DIMENSION(klon)                 :: sn
107    REAL,    DIMENSION(klon)                 :: rugmer
108    REAL,    DIMENSION(klon)                 :: run_off_lic_0
109    REAL,    DIMENSION(klon)                 :: lic
110    REAL,    DIMENSION(klon)                 :: fder
111
112    REAL,    DIMENSION(klon,nbsrf)           :: qsurf, snsrf
113    REAL,    DIMENSION(klon,nsoilmx,nbsrf)   :: tsoil
114   
115    REAL,    DIMENSION(klon_mpi)             :: tsol_mpi, qsol_mpi, zmasq_mpi, lic_mpi
116    REAL,    DIMENSION(klon_mpi)             :: zmea_mpi, zstd_mpi, zsig_mpi, zgam_mpi, zthe_mpi
117    REAL,    DIMENSION(klon_mpi)             :: cell_area_mpi
118    REAL,    DIMENSION(klon_mpi,nbsrf)       :: pctsrf_mpi
119
120    INTEGER :: ji,j,i
121 
122
123!--- Initial atmospheric CO2 conc. from .def file
124    co2_ppm0 = co2_ppm
125
126    IF (is_omp_master) THEN
127      CALL xios_recv_field("ts",tsol_mpi)
128      CALL xios_recv_field("qs",qsol_mpi)
129      CALL xios_recv_field("mask",zmasq_mpi)
130      IF (landice_opt .LT. 2) CALL xios_recv_field("landice",lic_mpi)
131    ENDIF
132    CALL scatter_omp(tsol_mpi,tsol)
133    CALL scatter_omp(qsol_mpi,qsol)
134    CALL scatter_omp(zmasq_mpi,zmasq)
135    IF (landice_opt .LT. 2) CALL scatter_omp(lic_mpi,lic)
136
137    radsol(:)   = 0.0
138    rugmer(:) = 0.001
139    sn(:)     = 0
140
141    WHERE(qsol(:)<0) qsol(:)=0
142       
143    WHERE(   zmasq(:)<EPSFRA) zmasq(:)=0.
144    WHERE(1.-zmasq(:)<EPSFRA) zmasq(:)=1.
145
146    pctsrf(:,:) = 0
147    IF (landice_opt .LT. 2) THEN
148       pctsrf(:,is_lic)=lic
149       WHERE(pctsrf(:,is_lic)<EPSFRA) pctsrf(:,is_lic)=0.
150       WHERE(zmasq(:)<EPSFRA)         pctsrf(:,is_lic)=0.
151
152       pctsrf(:,is_ter)=zmasq(:)
153       
154       !--- Adequation with soil/sea mask
155       DO ji=1,klon
156          IF(zmasq(ji)>EPSFRA) THEN
157             IF(pctsrf(ji,is_lic)>=zmasq(ji)) THEN
158                pctsrf(ji,is_lic)=zmasq(ji)
159                pctsrf(ji,is_ter)=0.
160             ELSE
161                pctsrf(ji,is_ter)=zmasq(ji)-pctsrf(ji,is_lic)
162                IF(pctsrf(ji,is_ter)<EPSFRA) THEN
163                   pctsrf(ji,is_ter)=0.
164                   pctsrf(ji,is_lic)=zmasq(ji)
165                END IF
166             END IF
167          END IF
168       END DO
169   
170    ELSE
171       ! landice_opt=>2 : no land ice
172       pctsrf(:,is_lic)=0.0
173       pctsrf(:,is_ter)=zmasq(:)
174    END IF
175
176
177
178
179
180  !--- Option no_ter_antartique removes all land fractions souther than 60S.
181  !--- Land ice is set instead of the land fractions on these latitudes.
182  !--- The ocean and sea-ice fractions are not changed.
183  !--- This option is only available if landice_opt<2.   
184  IF (landice_opt .LT. 2) THEN
185     no_ter_antartique=.FALSE.
186     CALL getin_p('no_ter_antartique',no_ter_antartique)
187     WRITE(lunout,*)"no_ter_antartique=",no_ter_antartique
188     IF (no_ter_antartique) THEN
189        ! Remove all land fractions souther than 60S and set land-ice instead
190        WRITE(lunout,*) "Remove land fractions souther than 60deg south by increasing"
191        WRITE(lunout,*) "the continental ice fractions. No land can now be found at Antartic."
192        DO ji=1, klon
193           IF (latitude_deg(ji)<-60.0) THEN
194              pctsrf(ji,is_lic) = pctsrf(ji,is_lic) + pctsrf(ji,is_ter)
195              pctsrf(ji,is_ter) = 0
196           END IF
197        END DO
198     END IF
199  END IF
200   
201! sub-surface ocean and sea ice (sea ice set to zero for start)
202!*******************************************************************************
203    pctsrf(:,is_oce)=(1.-zmasq(:))
204    WHERE(pctsrf(:,is_oce)<EPSFRA) pctsrf(:,is_oce)=0.
205   
206!    zval(:)=max(0.,zmea-2*zstd(:))
207!    zpic(:)=zmea+2*zstd(:)
208   
209!! WARNING    DON'T FORGET FOR LATER
210!!ym  IF(couple) pctsrf(:,is_oce)=ocemask_fi(:)
211!!
212   
213! Init: tsol, qsol, sn, evap, tsoil, rain_fall, snow_fall, solsw, sollw, frugs
214!*******************************************************************************
215    DO i=1,nbsrf
216     ftsol(:,i) = tsol
217    END DO
218 
219    DO i=1,nbsrf
220     snsrf(:,i) = sn
221    END DO
222!albedo SB >>>
223!ym error : the sub surface dimension is the third not second
224!    falb_dir(:,is_ter,:)=0.08; falb_dir(:,is_lic,:)=0.6
225!    falb_dir(:,is_oce,:)=0.5;  falb_dir(:,is_sic,:)=0.6
226    falb_dir(:,:,is_ter)=0.08; falb_dir(:,:,is_lic)=0.6
227    falb_dir(:,:,is_oce)=0.5;  falb_dir(:,:,is_sic)=0.6
228
229!ym falb_dif has been forgotten, initialize with defaukt value found in phyetat0 or 0 ?
230!ym probably the uninitialized value was 0 for standard (regular grid) case
231    falb_dif(:,:,:)=0
232    u10m(:,:)=0 
233    v10m(:,:)=0 
234    treedrg(:,:,:)=0
235!albedo SB <<<
236    fevap(:,:) = 0.
237    qsurf = 0.
238   
239    DO i=1,nbsrf
240      DO j=1,nsoilmx
241        tsoil(:,j,i) = tsol
242      END DO
243    END DO
244 
245    rain_fall = 0.; snow_fall = 0.
246    solsw = 165.;   sollw = -53.
247    solswfdiff = 1.
248!ym warning missing init for sollwdown => set to 0
249  sollwdown  = 0.
250   
251   
252    t_ancien = 273.15
253    u_ancien=0
254    v_ancien=0
255    q_ancien = 0.
256    ql_ancien = 0.
257    qs_ancien = 0.
258    prlw_ancien = 0.
259    prsw_ancien = 0.
260    prw_ancien = 0.
261    agesno = 0.
262   
263    ! LSCP condensation and ice supersaturation
264    cf_ancien = 0.
265    rvc_ancien = 0.
266    ! TKE when advected
267    tke_ancien = 0.
268
269    wake_delta_pbl_TKE(:,:,:)=0
270    wake_dens(:)=0
271    awake_dens = 0.
272    cv_gen = 0.
273    ale_bl = 0.
274    ale_bl_trig =0.
275    alp_bl=0.
276    ale_wake=0.
277    ale_bl_stat=0.
278   
279    z0m(:,:)=0 ! ym missing 5th subsurface initialization
280    z0m(:,is_oce) = rugmer(:)
281    z0m(:,is_ter) = 0.01 ! MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
282    z0m(:,is_lic) = 0.001 !MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
283    z0m(:,is_sic) = 0.001
284    z0h(:,:)=z0m(:,:)
285
286    fder = 0.0
287    clwcon = 0.0
288    rnebcon = 0.0
289    ratqs = 0.0
290    run_off_lic_0 = 0.0
291    rugoro = 0.0
292
293! Before phyredem calling, surface modules and values to be saved in startphy.nc
294! are initialized
295!*******************************************************************************
296    pbl_tke(:,:,:) = 1.e-8
297    zmax0(:) = 40.
298    f0(:) = 1.e-5
299    sig1(:,:) = 0.
300    w01(:,:) = 0.
301    wake_deltat(:,:) = 0.
302    wake_deltaq(:,:) = 0.
303    wake_s(:) = 0.
304    wake_cstar(:) = 0.
305    wake_fip(:) = 0.
306    wake_pe = 0.
307    fm_therm = 0.
308    entr_therm = 0.
309    detr_therm = 0.
310    awake_s = 0.
311
312    CALL fonte_neige_init(run_off_lic_0)
313    !GG
314    ! CALL pbl_surface_init( fder, snsrf, qsolsrf, tsoil )
315    CALL pbl_surface_init( fder, snsrf, qsurf, tsoil, hice, tice, bilg_cumul )
316    !GG
317
318
319    IF (iflag_pbl>1 .AND. iflag_wake>=1  .AND. iflag_pbl_split >=1) then
320     delta_tsurf = 0.
321     beta_aridity = 0.
322    END IF
323    ratqs_inter_ = 0.002
324
325    CALL gather_omp(cell_area,cell_area_mpi)
326    CALL gather_omp(pctsrf,pctsrf_mpi)
327    IF (is_omp_master) THEN
328      CALL xios_send_field("area_ce0l",cell_area_mpi)
329      CALL xios_send_field("fract_oce_ce0l",pctsrf_mpi(:,is_oce))
330      CALL xios_send_field("fract_sic_ce0l",pctsrf_mpi(:,is_sic))
331    ENDIF
332   
333    zmea(:) = zmea_gw(:)
334    zpic(:) = zpic_gw(:)
335    zval(:) = zval_gw(:)
336    zstd(:) = zstd_gw(:)
337    zsig(:) = zsig_gw(:)
338    zgam(:) = zgam_gw(:)
339    zthe(:) = zthe_gw(:)
340    DEALLOCATE(zmea_gw, zpic_gw, zval_gw, zstd_gw, zsig_gw, zgam_gw, zthe_gw)
341
342    CALL phyredem( "startphy.nc" )
343
344  END SUBROUTINE create_etat0_unstruct
345
346
347END MODULE create_etat0_unstruct_mod
Note: See TracBrowser for help on using the repository browser.