| 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 |
|
|
|