source: LMDZ6/trunk/libf/phylmd/create_etat0_unstruct.F90 @ 3479

Last change on this file since 3479 was 3466, checked in by Laurent Fairhead, 5 years ago

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