source: LMDZ6/branches/Test_modipsl/libf/phylmd/create_etat0_unstruct.F90 @ 5456

Last change on this file since 5456 was 4283, checked in by jghattas, 2 years ago

Added landice_opt=2 : Treat continental land ice fractions in ORCHIDEE => pctsrf(:,is_lic) = 0.0 in LMDZ.

For this option, some more variables are needed from ORCHIDEE. Therfor change in the interface LMDZ-ORCHIDEE in surf_land_orchidee_mod is done. Previous interface is moved to surf_land_orchidee_nolic_mod.f90. To compile with previous interface, cpp key ORCHIDEE_NOLIC is added. Previous interface is compiled with argument orchidee2.1 in makelmdz and makelmdz_fcm.

At the same time, when the interface was changed, the variable yrmu0(coszang) was added in the call to intersurf_initialize_gathered. This is needed in ORCHIDEE to better initialize the model.

Modifications done by Etienne Vignon and Josefine Ghattas
File size: 8.1 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  no_ter_antartique=.FALSE.
150  CALL getin_p('no_ter_antartique',no_ter_antartique)
151  WRITE(lunout,*)"no_ter_antartique=",no_ter_antartique
152  IF (no_ter_antartique) THEN
153     ! Remove all land fractions souther than 60S and set land-ice instead
154     WRITE(lunout,*) "Remove land fractions souther than 60deg south by increasing"
155     WRITE(lunout,*) "the continental ice fractions. No land can now be found at Antartic."
156     DO ji=1, klon
157        IF (latitude_deg(ji)<-60.0) THEN
158           pctsrf(ji,is_lic) = pctsrf(ji,is_lic) + pctsrf(ji,is_ter)
159           pctsrf(ji,is_ter) = 0
160        END IF
161     END DO
162  END IF
163   
164! sub-surface ocean and sea ice (sea ice set to zero for start)
165!*******************************************************************************
166    pctsrf(:,is_oce)=(1.-zmasq(:))
167    WHERE(pctsrf(:,is_oce)<EPSFRA) pctsrf(:,is_oce)=0.
168   
169    zval(:)=max(0.,zmea-2*zstd(:))
170    zpic(:)=zmea+2*zstd(:)
171   
172!! WARNING    DON'T FORGET FOR LATER
173!!ym  IF(couple) pctsrf(:,is_oce)=ocemask_fi(:)
174!!
175   
176! Init: tsol, qsol, sn, evap, tsoil, rain_fall, snow_fall, solsw, sollw, frugs
177!*******************************************************************************
178    DO i=1,nbsrf
179     ftsol(:,i) = tsol
180    END DO
181 
182    DO i=1,nbsrf
183     snsrf(:,i) = sn
184    END DO
185!albedo SB >>>
186!ym error : the sub surface dimension is the third not second
187!    falb_dir(:,is_ter,:)=0.08; falb_dir(:,is_lic,:)=0.6
188!    falb_dir(:,is_oce,:)=0.5;  falb_dir(:,is_sic,:)=0.6
189    falb_dir(:,:,is_ter)=0.08; falb_dir(:,:,is_lic)=0.6
190    falb_dir(:,:,is_oce)=0.5;  falb_dir(:,:,is_sic)=0.6
191
192!ym falb_dif has been forgotten, initialize with defaukt value found in phyetat0 or 0 ?
193!ym probably the uninitialized value was 0 for standard (regular grid) case
194    falb_dif(:,:,:)=0
195
196!albedo SB <<<
197    fevap(:,:) = 0.
198    DO i=1,nbsrf
199     qsolsrf(:,i)=150.
200    END DO
201 
202    DO i=1,nbsrf
203      DO j=1,nsoilmx
204        tsoil(:,j,i) = tsol
205      END DO
206    END DO
207 
208    rain_fall = 0.; snow_fall = 0.
209    solsw = 165.;   sollw = -53.
210!ym warning missing init for sollwdown => set to 0
211  sollwdown  = 0.
212   
213   
214    t_ancien = 273.15
215    u_ancien=0
216    v_ancien=0
217    q_ancien = 0.
218    agesno = 0.
219
220    z0m(:,is_oce) = rugmer(:)
221
222   z0m(:,is_ter) = 0.01 ! MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
223   z0m(:,is_lic) = 0.001 !MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
224
225   z0m(:,is_sic) = 0.001
226   z0h(:,:)=z0m(:,:)
227
228    fder = 0.0
229    clwcon = 0.0
230    rnebcon = 0.0
231    ratqs = 0.0
232    run_off_lic_0 = 0.0
233    rugoro = 0.0
234
235! Before phyredem calling, surface modules and values to be saved in startphy.nc
236! are initialized
237!*******************************************************************************
238    pbl_tke(:,:,:) = 1.e-8
239    zmax0(:) = 40.
240    f0(:) = 1.e-5
241    sig1(:,:) = 0.
242    w01(:,:) = 0.
243    wake_deltat(:,:) = 0.
244    wake_deltaq(:,:) = 0.
245    wake_s(:) = 0.
246    wake_cstar(:) = 0.
247    wake_fip(:) = 0.
248    wake_pe = 0.
249    fm_therm = 0.
250    entr_therm = 0.
251    detr_therm = 0.
252    ale_bl = 0.
253    ale_bl_trig =0.
254    alp_bl =0.
255    CALL fonte_neige_init(run_off_lic_0)
256    CALL pbl_surface_init( fder, snsrf, qsolsrf, tsoil )
257
258    CALL gather_omp(cell_area,cell_area_mpi)
259    CALL gather_omp(pctsrf,pctsrf_mpi)
260    IF (is_omp_master) THEN
261      CALL xios_send_field("area_ce0l",cell_area_mpi)
262      CALL xios_send_field("fract_oce_ce0l",pctsrf_mpi(:,is_oce))
263      CALL xios_send_field("fract_sic_ce0l",pctsrf_mpi(:,is_sic))
264    ENDIF
265   
266    CALL phyredem( "startphy.nc" )
267
268#endif
269  END SUBROUTINE create_etat0_unstruct
270
271
272END MODULE create_etat0_unstruct_mod
Note: See TracBrowser for help on using the repository browser.