source: LMDZ6/branches/LMDZ_ECRad/libf/phylmd/create_etat0_unstruct_mod.F90 @ 4987

Last change on this file since 4987 was 4727, checked in by idelkadi, 13 months ago

Merged trunk changes -r4488:4726 LMDZ_ECRad branch
File size: 8.2 KB
Line 
1MODULE create_etat0_unstruct_mod
2
3
4
5
6
7
8CONTAINS
9 
10  SUBROUTINE init_create_etat0_unstruct
11  USE lmdz_xios
12  USE netcdf
13  USE mod_phys_lmdz_para
14  IMPLICIT NONE
15  INTEGER :: file_id, iret
16 
17   ! for coupling activate ocean fraction reading from file "ocean_fraction.nc"
18    IF (is_omp_master) THEN
19
20      IF (NF90_OPEN("ocean_fraction.nc", NF90_NOWRITE, file_id)==NF90_NOERR) THEN
21        CALL xios_set_file_attr("frac_ocean",enabled=.TRUE.)
22        CALL xios_set_field_attr("mask",field_ref="frac_ocean_read")
23        iret=NF90_CLOSE(file_id)
24      ELSE IF (NF90_OPEN("land_water_0.05.nc", NF90_NOWRITE, file_id)==NF90_NOERR) THEN
25        CALL xios_set_file_attr("land_water",name="land_water_0.05",enabled=.TRUE.)
26        CALL xios_set_field_attr("mask",field_ref="land_water")
27        iret=NF90_CLOSE(file_id)
28      ELSE IF (NF90_OPEN("land_water_0.25.nc", NF90_NOWRITE, file_id)==NF90_NOERR) THEN
29        CALL xios_set_file_attr("land_water",name="land_water_0.25",enabled=.TRUE.)
30        CALL xios_set_field_attr("mask",field_ref="land_water")
31        iret=NF90_CLOSE(file_id)
32      ELSE IF (NF90_OPEN("land_water_0.50.nc", NF90_NOWRITE, file_id)==NF90_NOERR) THEN
33        CALL xios_set_file_attr("land_water",name="land_water_0.50",enabled=.TRUE.)
34        CALL xios_set_field_attr("mask",field_ref="land_water")
35        iret=NF90_CLOSE(file_id)
36      ENDIF
37
38    ENDIF
39
40  END SUBROUTINE init_create_etat0_unstruct
41 
42 
43  SUBROUTINE create_etat0_unstruct
44  USE dimphy
45  USE lmdz_xios
46  USE infotrac_phy
47  USE fonte_neige_mod
48  USE pbl_surface_mod
49  USE phys_state_var_mod
50  USE indice_sol_mod
51  USE surface_data,      ONLY: landice_opt
52  USE mod_phys_lmdz_para
53  USE print_control_mod, ONLY: lunout
54  USE geometry_mod
55  USE ioipsl_getin_p_mod, ONLY: getin_p
56
57  IMPLICIT NONE
58  INCLUDE 'dimsoil.h'
59
60    LOGICAL :: no_ter_antartique   ! If true, no land points are allowed at Antartic
61    REAL,    DIMENSION(klon)                 :: tsol
62    REAL,    DIMENSION(klon)                 :: sn
63    REAL,    DIMENSION(klon)                 :: rugmer
64    REAL,    DIMENSION(klon)                 :: run_off_lic_0
65    REAL,    DIMENSION(klon)                 :: lic
66    REAL,    DIMENSION(klon)                 :: fder
67
68    REAL,    DIMENSION(klon,nbsrf)           :: qsolsrf, snsrf
69    REAL,    DIMENSION(klon,nsoilmx,nbsrf)   :: tsoil
70   
71    REAL,    DIMENSION(klon_mpi)             :: tsol_mpi, qsol_mpi, zmasq_mpi, lic_mpi
72    REAL,    DIMENSION(klon_mpi)             :: zmea_mpi, zstd_mpi, zsig_mpi, zgam_mpi, zthe_mpi
73    REAL,    DIMENSION(klon_mpi)             :: cell_area_mpi
74    REAL,    DIMENSION(klon_mpi,nbsrf)       :: pctsrf_mpi
75
76    INTEGER :: ji,j,i
77 
78    IF (is_omp_master) THEN
79      CALL xios_recv_field("ts",tsol_mpi)
80      CALL xios_recv_field("qs",qsol_mpi)
81      CALL xios_recv_field("mask",zmasq_mpi)
82      IF (landice_opt .LT. 2) CALL xios_recv_field("landice",lic_mpi)
83      CALL xios_recv_field("zmea",zmea_mpi)
84      CALL xios_recv_field("zstd",zstd_mpi)
85      CALL xios_recv_field("zsig",zsig_mpi)
86      CALL xios_recv_field("zgam",zgam_mpi)
87      CALL xios_recv_field("zthe",zthe_mpi)
88    ENDIF
89    CALL scatter_omp(tsol_mpi,tsol)
90    CALL scatter_omp(qsol_mpi,qsol)
91    CALL scatter_omp(zmasq_mpi,zmasq)
92    IF (landice_opt .LT. 2) CALL scatter_omp(lic_mpi,lic)
93    CALL scatter_omp(zmea_mpi,zmea)
94    CALL scatter_omp(zstd_mpi,zstd)
95    CALL scatter_omp(zsig_mpi,zsig)
96    CALL scatter_omp(zgam_mpi,zgam)
97    CALL scatter_omp(zthe_mpi,zthe)
98
99    radsol(:)   = 0.0
100    rugmer(:) = 0.001
101    sn(:)     = 0
102
103    WHERE(qsol(:)<0) qsol(:)=0
104       
105    WHERE(   zmasq(:)<EPSFRA) zmasq(:)=0.
106    WHERE(1.-zmasq(:)<EPSFRA) zmasq(:)=1.
107
108    pctsrf(:,:) = 0
109    IF (landice_opt .LT. 2) THEN
110       pctsrf(:,is_lic)=lic
111       WHERE(pctsrf(:,is_lic)<EPSFRA) pctsrf(:,is_lic)=0.
112       WHERE(zmasq(:)<EPSFRA)         pctsrf(:,is_lic)=0.
113
114       pctsrf(:,is_ter)=zmasq(:)
115       
116       !--- Adequation with soil/sea mask
117       DO ji=1,klon
118          IF(zmasq(ji)>EPSFRA) THEN
119             IF(pctsrf(ji,is_lic)>=zmasq(ji)) THEN
120                pctsrf(ji,is_lic)=zmasq(ji)
121                pctsrf(ji,is_ter)=0.
122             ELSE
123                pctsrf(ji,is_ter)=zmasq(ji)-pctsrf(ji,is_lic)
124                IF(pctsrf(ji,is_ter)<EPSFRA) THEN
125                   pctsrf(ji,is_ter)=0.
126                   pctsrf(ji,is_lic)=zmasq(ji)
127                END IF
128             END IF
129          END IF
130       END DO
131   
132    ELSE
133       ! landice_opt=>2 : no land ice
134       pctsrf(:,is_lic)=0.0
135       pctsrf(:,is_ter)=zmasq(:)
136    END IF
137
138
139
140
141
142  !--- Option no_ter_antartique removes all land fractions souther than 60S.
143  !--- Land ice is set instead of the land fractions on these latitudes.
144  !--- The ocean and sea-ice fractions are not changed.
145  !--- This option is only available if landice_opt<2.   
146  IF (landice_opt .LT. 2) THEN
147     no_ter_antartique=.FALSE.
148     CALL getin_p('no_ter_antartique',no_ter_antartique)
149     WRITE(lunout,*)"no_ter_antartique=",no_ter_antartique
150     IF (no_ter_antartique) THEN
151        ! Remove all land fractions souther than 60S and set land-ice instead
152        WRITE(lunout,*) "Remove land fractions souther than 60deg south by increasing"
153        WRITE(lunout,*) "the continental ice fractions. No land can now be found at Antartic."
154        DO ji=1, klon
155           IF (latitude_deg(ji)<-60.0) THEN
156              pctsrf(ji,is_lic) = pctsrf(ji,is_lic) + pctsrf(ji,is_ter)
157              pctsrf(ji,is_ter) = 0
158           END IF
159        END DO
160     END IF
161  END IF
162   
163! sub-surface ocean and sea ice (sea ice set to zero for start)
164!*******************************************************************************
165    pctsrf(:,is_oce)=(1.-zmasq(:))
166    WHERE(pctsrf(:,is_oce)<EPSFRA) pctsrf(:,is_oce)=0.
167   
168    zval(:)=max(0.,zmea-2*zstd(:))
169    zpic(:)=zmea+2*zstd(:)
170   
171!! WARNING    DON'T FORGET FOR LATER
172!!ym  IF(couple) pctsrf(:,is_oce)=ocemask_fi(:)
173!!
174   
175! Init: tsol, qsol, sn, evap, tsoil, rain_fall, snow_fall, solsw, sollw, frugs
176!*******************************************************************************
177    DO i=1,nbsrf
178     ftsol(:,i) = tsol
179    END DO
180 
181    DO i=1,nbsrf
182     snsrf(:,i) = sn
183    END DO
184!albedo SB >>>
185!ym error : the sub surface dimension is the third not second
186!    falb_dir(:,is_ter,:)=0.08; falb_dir(:,is_lic,:)=0.6
187!    falb_dir(:,is_oce,:)=0.5;  falb_dir(:,is_sic,:)=0.6
188    falb_dir(:,:,is_ter)=0.08; falb_dir(:,:,is_lic)=0.6
189    falb_dir(:,:,is_oce)=0.5;  falb_dir(:,:,is_sic)=0.6
190
191!ym falb_dif has been forgotten, initialize with defaukt value found in phyetat0 or 0 ?
192!ym probably the uninitialized value was 0 for standard (regular grid) case
193    falb_dif(:,:,:)=0
194
195!albedo SB <<<
196    fevap(:,:) = 0.
197    DO i=1,nbsrf
198     qsolsrf(:,i)=150.
199    END DO
200 
201    DO i=1,nbsrf
202      DO j=1,nsoilmx
203        tsoil(:,j,i) = tsol
204      END DO
205    END DO
206 
207    rain_fall = 0.; snow_fall = 0.
208    solsw = 165.;   sollw = -53.
209!ym warning missing init for sollwdown => set to 0
210  sollwdown  = 0.
211   
212   
213    t_ancien = 273.15
214    u_ancien=0
215    v_ancien=0
216    q_ancien = 0.
217    agesno = 0.
218
219    z0m(:,is_oce) = rugmer(:)
220
221   z0m(:,is_ter) = 0.01 ! MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
222   z0m(:,is_lic) = 0.001 !MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
223
224   z0m(:,is_sic) = 0.001
225   z0h(:,:)=z0m(:,:)
226
227    fder = 0.0
228    clwcon = 0.0
229    rnebcon = 0.0
230    ratqs = 0.0
231    run_off_lic_0 = 0.0
232    rugoro = 0.0
233
234! Before phyredem calling, surface modules and values to be saved in startphy.nc
235! are initialized
236!*******************************************************************************
237    pbl_tke(:,:,:) = 1.e-8
238    zmax0(:) = 40.
239    f0(:) = 1.e-5
240    sig1(:,:) = 0.
241    w01(:,:) = 0.
242    wake_deltat(:,:) = 0.
243    wake_deltaq(:,:) = 0.
244    wake_s(:) = 0.
245    wake_cstar(:) = 0.
246    wake_fip(:) = 0.
247    wake_pe = 0.
248    fm_therm = 0.
249    entr_therm = 0.
250    detr_therm = 0.
251    ale_bl = 0.
252    ale_bl_trig =0.
253    alp_bl =0.
254    CALL fonte_neige_init(run_off_lic_0)
255    CALL pbl_surface_init( fder, snsrf, qsolsrf, tsoil )
256
257    CALL gather_omp(cell_area,cell_area_mpi)
258    CALL gather_omp(pctsrf,pctsrf_mpi)
259    IF (is_omp_master) THEN
260      CALL xios_send_field("area_ce0l",cell_area_mpi)
261      CALL xios_send_field("fract_oce_ce0l",pctsrf_mpi(:,is_oce))
262      CALL xios_send_field("fract_sic_ce0l",pctsrf_mpi(:,is_sic))
263    ENDIF
264   
265    CALL phyredem( "startphy.nc" )
266
267  END SUBROUTINE create_etat0_unstruct
268
269
270END MODULE create_etat0_unstruct_mod
Note: See TracBrowser for help on using the repository browser.