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

Last change on this file since 5421 was 5296, checked in by abarral, 7 weeks ago

Turn compbl.h into a module
Move calcul_REGDYN.h to obsolete
Create phys_constants_mod.f90

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