| 1 | MODULE create_etat0_unstruct_mod |
|---|
| 2 | |
|---|
| 3 | |
|---|
| 4 | |
|---|
| 5 | |
|---|
| 6 | |
|---|
| 7 | |
|---|
| 8 | CONTAINS |
|---|
| 9 | |
|---|
| 10 | SUBROUTINE create_etat0_unstruct |
|---|
| 11 | USE dimphy |
|---|
| 12 | USE xios |
|---|
| 13 | USE infotrac_phy |
|---|
| 14 | USE fonte_neige_mod |
|---|
| 15 | USE pbl_surface_mod |
|---|
| 16 | USE phys_state_var_mod |
|---|
| 17 | USE indice_sol_mod |
|---|
| 18 | USE mod_phys_lmdz_para |
|---|
| 19 | IMPLICIT NONE |
|---|
| 20 | INCLUDE 'dimsoil.h' |
|---|
| 21 | |
|---|
| 22 | REAL, DIMENSION(klon) :: tsol |
|---|
| 23 | REAL, DIMENSION(klon) :: sn |
|---|
| 24 | REAL, DIMENSION(klon) :: rugmer |
|---|
| 25 | REAL, DIMENSION(klon) :: run_off_lic_0 |
|---|
| 26 | REAL, DIMENSION(klon) :: lic |
|---|
| 27 | REAL, DIMENSION(klon) :: fder |
|---|
| 28 | |
|---|
| 29 | REAL, DIMENSION(klon,nbsrf) :: qsolsrf, snsrf |
|---|
| 30 | REAL, DIMENSION(klon,nsoilmx,nbsrf) :: tsoil |
|---|
| 31 | |
|---|
| 32 | REAL, DIMENSION(klon_mpi) :: tsol_mpi, qsol_mpi, zmasq_mpi, lic_mpi |
|---|
| 33 | REAL, DIMENSION(klon_mpi) :: zmea_mpi, zstd_mpi, zsig_mpi, zgam_mpi, zthe_mpi |
|---|
| 34 | |
|---|
| 35 | INTEGER :: ji,j,i |
|---|
| 36 | |
|---|
| 37 | IF (is_omp_master) THEN |
|---|
| 38 | CALL xios_recv_field("ts",tsol_mpi) |
|---|
| 39 | CALL xios_recv_field("qs",qsol_mpi) |
|---|
| 40 | CALL xios_recv_field("mask",zmasq_mpi) |
|---|
| 41 | CALL xios_recv_field("landice",lic_mpi) |
|---|
| 42 | CALL xios_recv_field("zmea",zmea_mpi) |
|---|
| 43 | CALL xios_recv_field("zstd",zstd_mpi) |
|---|
| 44 | CALL xios_recv_field("zsig",zsig_mpi) |
|---|
| 45 | CALL xios_recv_field("zgam",zgam_mpi) |
|---|
| 46 | CALL xios_recv_field("zthe",zthe_mpi) |
|---|
| 47 | ENDIF |
|---|
| 48 | CALL scatter_omp(tsol_mpi,tsol) |
|---|
| 49 | CALL scatter_omp(qsol_mpi,qsol) |
|---|
| 50 | CALL scatter_omp(zmasq_mpi,zmasq) |
|---|
| 51 | CALL scatter_omp(lic_mpi,lic) |
|---|
| 52 | CALL scatter_omp(zmea_mpi,zmea) |
|---|
| 53 | CALL scatter_omp(zstd_mpi,zstd) |
|---|
| 54 | CALL scatter_omp(zsig_mpi,zsig) |
|---|
| 55 | CALL scatter_omp(zgam_mpi,zgam) |
|---|
| 56 | CALL scatter_omp(zthe_mpi,zthe) |
|---|
| 57 | |
|---|
| 58 | radsol(:) = 0.0 |
|---|
| 59 | rugmer(:) = 0.001 |
|---|
| 60 | sn(:) = 0 |
|---|
| 61 | |
|---|
| 62 | WHERE(qsol(:)<0) qsol(:)=0 |
|---|
| 63 | |
|---|
| 64 | WHERE( zmasq(:)<EPSFRA) zmasq(:)=0. |
|---|
| 65 | WHERE(1.-zmasq(:)<EPSFRA) zmasq(:)=1. |
|---|
| 66 | |
|---|
| 67 | pctsrf(:,:) = 0 |
|---|
| 68 | pctsrf(:,is_lic)=lic |
|---|
| 69 | WHERE(pctsrf(:,is_lic)<EPSFRA) pctsrf(:,is_lic)=0. |
|---|
| 70 | WHERE(zmasq(:)<EPSFRA) pctsrf(:,is_lic)=0. |
|---|
| 71 | |
|---|
| 72 | pctsrf(:,is_ter)=zmasq(:) |
|---|
| 73 | |
|---|
| 74 | !--- Adequation with soil/sea mask |
|---|
| 75 | DO ji=1,klon |
|---|
| 76 | IF(zmasq(ji)>EPSFRA) THEN |
|---|
| 77 | IF(pctsrf(ji,is_lic)>=zmasq(ji)) THEN |
|---|
| 78 | pctsrf(ji,is_lic)=zmasq(ji) |
|---|
| 79 | pctsrf(ji,is_ter)=0. |
|---|
| 80 | ELSE |
|---|
| 81 | pctsrf(ji,is_ter)=zmasq(ji)-pctsrf(ji,is_lic) |
|---|
| 82 | IF(pctsrf(ji,is_ter)<EPSFRA) THEN |
|---|
| 83 | pctsrf(ji,is_ter)=0. |
|---|
| 84 | pctsrf(ji,is_lic)=zmasq(ji) |
|---|
| 85 | END IF |
|---|
| 86 | END IF |
|---|
| 87 | END IF |
|---|
| 88 | END DO |
|---|
| 89 | |
|---|
| 90 | ! sub-surface ocean and sea ice (sea ice set to zero for start) |
|---|
| 91 | !******************************************************************************* |
|---|
| 92 | pctsrf(:,is_oce)=(1.-zmasq(:)) |
|---|
| 93 | WHERE(pctsrf(:,is_oce)<EPSFRA) pctsrf(:,is_oce)=0. |
|---|
| 94 | |
|---|
| 95 | zval(:)=max(0.,zmea-2*zstd(:)) |
|---|
| 96 | zpic(:)=zmea+2*zstd(:) |
|---|
| 97 | |
|---|
| 98 | !! WARNING DON'T FORGET FOR LATER |
|---|
| 99 | !!ym IF(couple) pctsrf(:,is_oce)=ocemask_fi(:) |
|---|
| 100 | !! |
|---|
| 101 | |
|---|
| 102 | ! Init: tsol, qsol, sn, evap, tsoil, rain_fall, snow_fall, solsw, sollw, frugs |
|---|
| 103 | !******************************************************************************* |
|---|
| 104 | DO i=1,nbsrf |
|---|
| 105 | ftsol(:,i) = tsol |
|---|
| 106 | END DO |
|---|
| 107 | |
|---|
| 108 | DO i=1,nbsrf |
|---|
| 109 | snsrf(:,i) = sn |
|---|
| 110 | END DO |
|---|
| 111 | !albedo SB >>> |
|---|
| 112 | !ym error : the sub surface dimension is the third not second |
|---|
| 113 | ! falb_dir(:,is_ter,:)=0.08; falb_dir(:,is_lic,:)=0.6 |
|---|
| 114 | ! falb_dir(:,is_oce,:)=0.5; falb_dir(:,is_sic,:)=0.6 |
|---|
| 115 | falb_dir(:,:,is_ter)=0.08; falb_dir(:,:,is_lic)=0.6 |
|---|
| 116 | falb_dir(:,:,is_oce)=0.5; falb_dir(:,:,is_sic)=0.6 |
|---|
| 117 | |
|---|
| 118 | !ym falb_dif has been forgotten, initialize with defaukt value found in phyetat0 or 0 ? |
|---|
| 119 | !ym probably the uninitialized value was 0 for standard (regular grid) case |
|---|
| 120 | falb_dif(:,:,:)=0 |
|---|
| 121 | |
|---|
| 122 | !albedo SB <<< |
|---|
| 123 | fevap(:,:) = 0. |
|---|
| 124 | DO i=1,nbsrf |
|---|
| 125 | qsolsrf(:,i)=150. |
|---|
| 126 | END DO |
|---|
| 127 | |
|---|
| 128 | DO i=1,nbsrf |
|---|
| 129 | DO j=1,nsoilmx |
|---|
| 130 | tsoil(:,j,i) = tsol |
|---|
| 131 | END DO |
|---|
| 132 | END DO |
|---|
| 133 | |
|---|
| 134 | rain_fall = 0.; snow_fall = 0. |
|---|
| 135 | solsw = 165.; sollw = -53. |
|---|
| 136 | t_ancien = 273.15 |
|---|
| 137 | u_ancien=0 |
|---|
| 138 | v_ancien=0 |
|---|
| 139 | q_ancien = 0. |
|---|
| 140 | agesno = 0. |
|---|
| 141 | |
|---|
| 142 | z0m(:,is_oce) = rugmer(:) |
|---|
| 143 | |
|---|
| 144 | z0m(:,is_ter) = MAX(1.0e-05,zstd(:)*zsig(:)/2.0) |
|---|
| 145 | z0m(:,is_lic) = MAX(1.0e-05,zstd(:)*zsig(:)/2.0) |
|---|
| 146 | |
|---|
| 147 | z0m(:,is_sic) = 0.001 |
|---|
| 148 | z0h(:,:)=z0m(:,:) |
|---|
| 149 | |
|---|
| 150 | fder = 0.0 |
|---|
| 151 | clwcon = 0.0 |
|---|
| 152 | rnebcon = 0.0 |
|---|
| 153 | ratqs = 0.0 |
|---|
| 154 | run_off_lic_0 = 0.0 |
|---|
| 155 | rugoro = 0.0 |
|---|
| 156 | |
|---|
| 157 | ! Before phyredem calling, surface modules and values to be saved in startphy.nc |
|---|
| 158 | ! are initialized |
|---|
| 159 | !******************************************************************************* |
|---|
| 160 | pbl_tke(:,:,:) = 1.e-8 |
|---|
| 161 | zmax0(:) = 40. |
|---|
| 162 | f0(:) = 1.e-5 |
|---|
| 163 | sig1(:,:) = 0. |
|---|
| 164 | w01(:,:) = 0. |
|---|
| 165 | wake_deltat(:,:) = 0. |
|---|
| 166 | wake_deltaq(:,:) = 0. |
|---|
| 167 | wake_s(:) = 0. |
|---|
| 168 | wake_cstar(:) = 0. |
|---|
| 169 | wake_fip(:) = 0. |
|---|
| 170 | wake_pe = 0. |
|---|
| 171 | fm_therm = 0. |
|---|
| 172 | entr_therm = 0. |
|---|
| 173 | detr_therm = 0. |
|---|
| 174 | ale_bl = 0. |
|---|
| 175 | ale_bl_trig =0. |
|---|
| 176 | alp_bl =0. |
|---|
| 177 | CALL fonte_neige_init(run_off_lic_0) |
|---|
| 178 | CALL pbl_surface_init( fder, snsrf, qsolsrf, tsoil ) |
|---|
| 179 | CALL phyredem( "startphy.nc" ) |
|---|
| 180 | |
|---|
| 181 | |
|---|
| 182 | END SUBROUTINE create_etat0_unstruct |
|---|
| 183 | |
|---|
| 184 | |
|---|
| 185 | END MODULE create_etat0_unstruct_mod |
|---|
