source: LMDZ5/trunk/libf/dynlonlat_phylonlat/phylmd/init_ssrf_m.F90 @ 2342

Last change on this file since 2342 was 2342, checked in by Ehouarn Millour, 9 years ago

Follow-up for a cleaner separation between dynamics and physics:

  • "write_field" is called from physics and dynamics but has no dependence on either so it should be in "misc"
  • "write_field_phy" is common to all physics, so it goes in "phy_common"
  • "init_ssrf_m" and "limit_netcdf" are only used by ce0l, so these should be in "dynlonlat_phylonlat/phylmd"
  • "q_sat" is called from physics and dynamics but has no dependence on either so it should be in "misc"

EM

File size: 4.4 KB
Line 
1MODULE init_ssrf_m
2!
3!*******************************************************************************
4
5  USE indice_sol_mod
6  USE dimphy,             ONLY: klon, zmasq
7  USE phys_state_var_mod, ONLY: pctsrf, rlon, rlat
8  USE grid_atob_m,        ONLY: grille_m
9  USE ioipsl,             ONLY: flininfo, flinopen, flinget, flinclo
10
11  CHARACTER(LEN=256), PARAMETER :: icefname="landiceref.nc", icevar="landice"
12  PRIVATE
13  PUBLIC :: start_init_subsurf
14  include "iniprint.h"
15  include "dimensions.h"
16  include "paramet.h"
17  include "comgeom2.h"
18  include "comconst.h"
19
20CONTAINS
21
22!-------------------------------------------------------------------------------
23!
24SUBROUTINE start_init_subsurf(known_mask)
25!
26!-------------------------------------------------------------------------------
27! Purpose: Subsurfaces initialization.
28!-------------------------------------------------------------------------------
29! Comment: Called by etat0phys_netcdf ; also called by limit_netcdf in case
30!          no starting states are required (ok_etat0==.FALSE.).
31!-------------------------------------------------------------------------------
32  IMPLICIT NONE
33!-------------------------------------------------------------------------------
34! Arguments:
35  LOGICAL, INTENT(IN) :: known_mask
36!-------------------------------------------------------------------------------
37! Local variables:
38  INTEGER           :: iml_lic, jml_lic
39  INTEGER           :: fid, llm_tmp, ttm_tmp, itaul(1), ji, j
40  REAL, ALLOCATABLE :: dlon_lic(:), lon_lic(:,:), fraclic (:,:)
41  REAL, ALLOCATABLE :: dlat_lic(:), lat_lic(:,:), flic_tmp(:,:), vtmp(:,:)
42  REAL              :: date, lev(1), dt, deg2rad
43!-------------------------------------------------------------------------------
44  deg2rad= pi/180.0
45
46!--- Physical grid points coordinates
47  DO j=2,jjm; rlat((j-2)*iim+2:(j-1)*iim+1)=rlatu(j);    END DO
48  DO j=2,jjm; rlon((j-2)*iim+2:(j-1)*iim+1)=rlonv(1:im); END DO
49  rlat(1) = pi/2.; rlat(klon) = - pi/2.; rlat(:)=rlat(:)/deg2rad
50  rlon(1) = 0.0;   rlon(klon) = 0.0;     rlon(:)=rlon(:)/deg2rad
51
52! Compute ground geopotential, sub-cells quantities and possibly the mask.
53! Sub-surfaces initialization
54!*******************************************************************************
55!--- Read and interpolate on model T-grid soil fraction and soil ice fraction.
56  CALL flininfo(icefname, iml_lic, jml_lic, llm_tmp, ttm_tmp, fid)
57  ALLOCATE(lat_lic(iml_lic,jml_lic),lon_lic(iml_lic,jml_lic))
58  ALLOCATE(fraclic(iml_lic,jml_lic))
59  CALL flinopen(icefname, .FALSE., iml_lic, jml_lic, llm_tmp,  &
60 &               lon_lic, lat_lic, lev, ttm_tmp, itaul, date, dt, fid)
61  CALL flinget(fid, icevar, iml_lic, jml_lic, llm_tmp, ttm_tmp, 1,1, fraclic)
62  CALL flinclo(fid)
63  WRITE(lunout,*)'landice dimensions: iml_lic, jml_lic : ',iml_lic,jml_lic
64
65  ALLOCATE(dlon_lic(iml_lic),dlat_lic(jml_lic))
66  dlon_lic(:)=lon_lic(:,1); IF(MAXVAL(dlon_lic)>pi) dlon_lic=dlon_lic*pi/180.
67  dlat_lic(:)=lat_lic(1,:); IF(MAXVAL(dlat_lic)>pi) dlat_lic=dlat_lic*pi/180.
68  DEALLOCATE(lon_lic,lat_lic); ALLOCATE(flic_tmp(iip1,jjp1))
69  CALL grille_m(dlon_lic,dlat_lic,fraclic,rlonv(1:iim),rlatu,flic_tmp(1:iim,:))
70  flic_tmp(iip1,:)=flic_tmp(1,:)
71
72!--- To the physical grid
73  pctsrf(:,:) = 0.
74  CALL gr_dyn_fi(1, iip1, jjp1, klon, flic_tmp, pctsrf(:,is_lic))
75  DEALLOCATE(flic_tmp)
76
77!--- Adequation with soil/sea mask
78  WHERE(pctsrf(:,is_lic)<EPSFRA) pctsrf(:,is_lic)=0.
79  WHERE(zmasq(:)<EPSFRA)         pctsrf(:,is_lic)=0.
80  pctsrf(:,is_ter)=zmasq(:)
81  DO ji=1,klon
82    IF(zmasq(ji)>EPSFRA) THEN
83      IF(pctsrf(ji,is_lic)>=zmasq(ji)) THEN
84        pctsrf(ji,is_lic)=zmasq(ji)
85        pctsrf(ji,is_ter)=0.
86      ELSE
87        pctsrf(ji,is_ter)=zmasq(ji)-pctsrf(ji,is_lic)
88        IF(pctsrf(ji,is_ter)<EPSFRA) THEN
89          pctsrf(ji,is_ter)=0.
90          pctsrf(ji,is_lic)=zmasq(ji)
91        END IF
92      END IF
93    END IF
94  END DO
95
96!--- Sub-surface ocean and sea ice (sea ice set to zero for start).
97  pctsrf(:,is_oce)=(1.-zmasq(:))
98  WHERE(pctsrf(:,is_oce)<EPSFRA) pctsrf(:,is_oce)=0.
99  IF(known_mask) pctsrf(:,is_oce)=1-zmasq(:)
100
101!--- It is checked that the sub-surfaces sum is equal to 1.
102  ji=COUNT((ABS(SUM(pctsrf(:,:),dim=2))-1.0)>EPSFRA)
103  IF(ji/=0) WRITE(lunout,*) 'Sub-cell distribution problem for ',ji,' points'
104
105END SUBROUTINE start_init_subsurf
106!
107!-------------------------------------------------------------------------------
108
109END MODULE init_ssrf_m
110!
111!*******************************************************************************
Note: See TracBrowser for help on using the repository browser.