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