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

Last change on this file since 4595 was 4595, checked in by jghattas, 11 months ago

Option no_ter_antartique is only read and used for the case landice_opt < 2. This was already the case on the regular grid.

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