GCC Code Coverage Report


Directory: ./
File: dyn_phys_sub/init_ssrf_m.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 54 0.0%
Branches: 0 136 0.0%

Line Branch Exec Source
1 MODULE init_ssrf_m
2 !
3 !*******************************************************************************
4
5 USE indice_sol_mod, ONLY: is_ter, is_oce, is_oce, is_lic, epsfra
6 USE dimphy, ONLY: klon, zmasq
7 USE phys_state_var_mod, ONLY: pctsrf
8 USE geometry_mod, ONLY : longitude_deg, latitude_deg
9 USE grid_atob_m, ONLY: grille_m
10 USE ioipsl, ONLY: flininfo, flinopen, flinget, flinclo
11 USE ioipsl_getin_p_mod, ONLY: getin_p
12 USE comconst_mod, ONLY: im, pi
13
14 CHARACTER(LEN=256), PARAMETER :: icefname="landiceref.nc", icevar="landice"
15 PRIVATE
16 PUBLIC :: start_init_subsurf
17 include "iniprint.h"
18 include "dimensions.h"
19 include "paramet.h"
20 include "comgeom2.h"
21
22 CONTAINS
23
24 !-------------------------------------------------------------------------------
25 !
26 SUBROUTINE start_init_subsurf(known_mask)
27 !
28 !-------------------------------------------------------------------------------
29 ! Purpose: Subsurfaces initialization.
30 !-------------------------------------------------------------------------------
31 ! Comment: Called by etat0phys_netcdf ; also called by limit_netcdf in case
32 ! no starting states are required (ok_etat0==.FALSE.).
33 !-------------------------------------------------------------------------------
34 IMPLICIT NONE
35 !-------------------------------------------------------------------------------
36 ! Arguments:
37 LOGICAL, INTENT(IN) :: known_mask
38 !-------------------------------------------------------------------------------
39 ! Local variables:
40 INTEGER :: iml_lic, jml_lic
41 INTEGER :: fid, llm_tmp, ttm_tmp, itaul(1), ji, j
42 REAL, ALLOCATABLE :: dlon_lic(:), lon_lic(:,:), fraclic (:,:)
43 REAL, ALLOCATABLE :: dlat_lic(:), lat_lic(:,:), flic_tmp(:,:), vtmp(:,:)
44 REAL :: date, lev(1), dt, deg2rad
45 LOGICAL :: no_ter_antartique ! If true, no land points are allowed at Antartic
46 !-------------------------------------------------------------------------------
47 deg2rad= pi/180.0
48
49 !--- Physical grid points coordinates
50 DO j=2,jjm; latitude_deg((j-2)*iim+2:(j-1)*iim+1)=rlatu(j); END DO
51 DO j=2,jjm; longitude_deg((j-2)*iim+2:(j-1)*iim+1)=rlonv(1:im); END DO
52 latitude_deg(1) = pi/2.; latitude_deg(klon) = - pi/2.
53 latitude_deg(:)=latitude_deg(:)/deg2rad
54 longitude_deg(1) = 0.0; longitude_deg(klon) = 0.0;
55 longitude_deg(:)=longitude_deg(:)/deg2rad
56
57 ! Compute ground geopotential, sub-cells quantities and possibly the mask.
58 ! Sub-surfaces initialization
59 !*******************************************************************************
60 !--- Read and interpolate on model T-grid soil fraction and soil ice fraction.
61 CALL flininfo(icefname, iml_lic, jml_lic, llm_tmp, ttm_tmp, fid)
62 ALLOCATE(lat_lic(iml_lic,jml_lic),lon_lic(iml_lic,jml_lic))
63 ALLOCATE(fraclic(iml_lic,jml_lic))
64 CALL flinopen(icefname, .FALSE., iml_lic, jml_lic, llm_tmp, &
65 & lon_lic, lat_lic, lev, ttm_tmp, itaul, date, dt, fid)
66 CALL flinget(fid, icevar, iml_lic, jml_lic, llm_tmp, ttm_tmp, 1,1, fraclic)
67 CALL flinclo(fid)
68 WRITE(lunout,*)'landice dimensions: iml_lic, jml_lic : ',iml_lic,jml_lic
69
70 ALLOCATE(dlon_lic(iml_lic),dlat_lic(jml_lic))
71 dlon_lic(:)=lon_lic(:,1); IF(MAXVAL(dlon_lic)>pi) dlon_lic=dlon_lic*pi/180.
72 dlat_lic(:)=lat_lic(1,:); IF(MAXVAL(dlat_lic)>pi) dlat_lic=dlat_lic*pi/180.
73 DEALLOCATE(lon_lic,lat_lic); ALLOCATE(flic_tmp(iip1,jjp1))
74 CALL grille_m(dlon_lic,dlat_lic,fraclic,rlonv(1:iim),rlatu,flic_tmp(1:iim,:))
75 flic_tmp(iip1,:)=flic_tmp(1,:)
76
77 !--- To the physical grid
78 pctsrf(:,:) = 0.
79 CALL gr_dyn_fi(1, iip1, jjp1, klon, flic_tmp, pctsrf(:,is_lic))
80 DEALLOCATE(flic_tmp)
81
82 !--- Adequation with soil/sea mask
83 WHERE(pctsrf(:,is_lic)<EPSFRA) pctsrf(:,is_lic)=0.
84 WHERE(zmasq(:)<EPSFRA) pctsrf(:,is_lic)=0.
85 pctsrf(:,is_ter)=zmasq(:)
86 DO ji=1,klon
87 IF(zmasq(ji)>EPSFRA) THEN
88 IF(pctsrf(ji,is_lic)>=zmasq(ji)) THEN
89 pctsrf(ji,is_lic)=zmasq(ji)
90 pctsrf(ji,is_ter)=0.
91 ELSE
92 pctsrf(ji,is_ter)=zmasq(ji)-pctsrf(ji,is_lic)
93 IF(pctsrf(ji,is_ter)<EPSFRA) THEN
94 pctsrf(ji,is_ter)=0.
95 pctsrf(ji,is_lic)=zmasq(ji)
96 END IF
97 END IF
98 END IF
99 END DO
100
101
102 !--- Option no_ter_antartique removes all land fractions souther than 60S.
103 !--- Land ice is set instead of the land fractions on these latitudes.
104 !--- The ocean and sea-ice fractions are not changed.
105 no_ter_antartique=.FALSE.
106 CALL getin_p('no_ter_antartique',no_ter_antartique)
107 WRITE(lunout,*)"no_ter_antartique=",no_ter_antartique
108 IF (no_ter_antartique) THEN
109 ! Remove all land fractions souther than 60S and set land-ice instead
110 WRITE(lunout,*) "Remove land fractions souther than 60deg south by increasing"
111 WRITE(lunout,*) "the continental ice fractions. No land can now be found at Antartic."
112 DO ji=1, klon
113 IF (latitude_deg(ji)<-60.0) THEN
114 pctsrf(ji,is_lic) = pctsrf(ji,is_lic) + pctsrf(ji,is_ter)
115 pctsrf(ji,is_ter) = 0
116 END IF
117 END DO
118 END IF
119
120
121 !--- Sub-surface ocean and sea ice (sea ice set to zero for start).
122 pctsrf(:,is_oce)=(1.-zmasq(:))
123 WHERE(pctsrf(:,is_oce)<EPSFRA) pctsrf(:,is_oce)=0.
124 IF(known_mask) pctsrf(:,is_oce)=1-zmasq(:)
125
126 !--- It is checked that the sub-surfaces sum is equal to 1.
127 ji=COUNT((ABS(SUM(pctsrf(:,:),dim=2))-1.0)>EPSFRA)
128 IF(ji/=0) WRITE(lunout,*) 'Sub-cell distribution problem for ',ji,' points'
129
130 END SUBROUTINE start_init_subsurf
131 !
132 !-------------------------------------------------------------------------------
133
134 END MODULE init_ssrf_m
135 !
136 !*******************************************************************************
137