- Timestamp:
- 09/02/19 12:22:39 (5 years ago)
- Location:
- codes/icosagcm/devel/src
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/devel/src/dissip/guided_mod.f90
r874 r968 8 8 9 9 10 SUBROUTINE init_guided(f_u,f_theta_rhodz )10 SUBROUTINE init_guided(f_u,f_theta_rhodz,f_ps) 11 11 USE icosa 12 12 USE guided_ncar_mod, ONLY : init_guided_ncar => init_guided … … 15 15 TYPE(t_field),POINTER :: f_u(:) 16 16 TYPE(t_field),POINTER :: f_theta_rhodz(:) 17 TYPE(t_field),POINTER :: f_ps(:) 17 18 18 19 guided_type='none' … … 26 27 27 28 CASE ('nudging') 28 CALL init_guided_nudging(f_u,f_theta_rhodz) 29 29 CALL init_guided_nudging(f_u,f_theta_rhodz,f_ps) 30 30 CASE DEFAULT 31 31 PRINT*,"Bad selector for varaible guided_type >",TRIM(guided_type),"> option are <none>, <dcmip1>, <nudging>" -
codes/icosagcm/devel/src/dissip/nudging_mod.f90
r948 r968 12 12 PRIVATE 13 13 ! nudging will be active outside a disc of radius 'radius' centered at 'center_lon', 'center lat'. 14 REAL(rstd) :: center_lon, center_lat, nudging_radius, time 15 !$OMP THREADPRIVATE(center_lon, center_lat, nudging_radius, time) 16 14 REAL(rstd) :: center_lon, center_lat, nudging_radius, nudging_relaxation_time 15 !$OMP THREADPRIVATE(center_lon, center_lat, nudging_radius, nudging_relaxation_time) 17 16 TYPE(t_field),POINTER :: f_relax_coef_e(:), f_target_ue(:), & 18 f_relax_coef_i(:), f_target_theta_rhodz(:) 17 f_relax_coef_i(:), f_target_theta_rhodz(:),f_target_ps(:) 19 18 CHARACTER(LEN=255),SAVE :: guided_nudging_field 20 19 INTEGER,SAVE :: nudging_time … … 24 23 CONTAINS 25 24 26 SUBROUTINE init_guided(f_u,f_theta_rhodz )25 SUBROUTINE init_guided(f_u,f_theta_rhodz,f_ps) 27 26 USE getin_mod, ONLY : getin 28 27 USE math_const, ONLY : pi … … 30 29 TYPE(t_field),POINTER :: f_u(:)! initial condition 31 30 TYPE(t_field),POINTER :: f_theta_rhodz(:)! initial condition 31 TYPE(t_field),POINTER :: f_ps(:)! initial condition 32 32 REAL(rstd), POINTER :: ue(:,:), target_ue(:,:), coef_e(:) 33 33 REAL(rstd), POINTER :: theta_rhodz(:,:,:), target_theta_rhodz(:,:,:), coef_i(:) 34 REAL(rstd), POINTER :: ps2(:), target_ps(:) 34 35 INTEGER :: ind 35 36 ! read DEF keys describing how to relax … … 41 42 CALL getin('nudging_radius', nudging_radius) 42 43 nudging_radius = nudging_radius / scale_factor 43 44 nudging_time=0. 44 ! we should check that radius>0 45 46 nudging_time=0 45 47 CALL getin('nudging_time', nudging_time) 46 48 nudging_time = nudging_time/scale_factor 47 ! we should check that radius>0 49 !nudging_time=0 50 51 nudging_relaxation_time = 0. 52 CALL getin('nudging_relaxation_time', nudging_relaxation_time) 53 nudging_relaxation_time = nudging_relaxation_time/scale_factor 54 48 55 CALL getin("guided_nudging_field",guided_nudging_field) 49 56 50 57 SELECT CASE(TRIM(guided_nudging_field)) 51 CASE ('wind') 52 CALL allocate_field(f_relax_coef_e, field_u, type_real, name='nudging_coef_e') 53 CALL allocate_field(f_target_ue, field_u, type_real, llm, name='nudging_target_e') 54 CASE ('temperature') 55 CALL allocate_field(f_relax_coef_i, field_t, type_real, name='nudging_coef_i') 56 CALL allocate_field(f_target_theta_rhodz, field_t, type_real, llm,nqdyn, name='nudging_target_theta') 57 CASE ('wind_temperature') 58 CASE('wind','temperature','wind_temperature') 58 59 CALL allocate_field(f_relax_coef_e, field_u, type_real, name='nudging_coef_e') 59 60 CALL allocate_field(f_target_ue, field_u, type_real, llm, name='nudging_target_e') 60 61 CALL allocate_field(f_relax_coef_i, field_t, type_real, name='nudging_coef_i') 61 62 CALL allocate_field(f_target_theta_rhodz, field_t, type_real, llm,nqdyn, name='nudging_target_theta') 63 CALL allocate_field(f_target_ps, field_t, type_real, name='nudging_target_ps') 62 64 CASE DEFAULT 63 65 PRINT*,"Bad selector for varaible init_guided_nudging>",TRIM(guided_nudging_field) … … 65 67 STOP 66 68 END SELECT 67 68 69 ! compute relax_coef and target_ue 69 70 center_lon = center_lon * pi/180. … … 79 80 target_theta_rhodz = f_target_theta_rhodz(ind) 80 81 theta_rhodz = f_theta_rhodz(ind) 82 target_ps = f_target_ps(ind) 83 ps2 = f_ps(ind) 81 84 CALL compute_relax_coef(coef_e, coef_i) 82 85 CALL compute_target_u(ue, target_ue) 83 86 CALL compute_target_center(theta_rhodz, target_theta_rhodz) 87 CALL compute_target_center2(ps2, target_ps) 84 88 END DO 85 89 END SUBROUTINE init_guided … … 101 105 FUNCTION relax_coef(lon,lat) 102 106 USE spherical_geom_mod, ONLY : dist_lonlat 107 USE time_mod!, ONLY : dt ! time step for a full RK step 103 108 REAL(rstd), INTENT(IN) :: lon,lat 104 109 REAL(rstd) :: relax_coef, dist, c 105 110 ! NB : dist is computed on unit sphere 106 CALL dist_lonlat(lon, lat, center_lon, center_lat, dist) 107 c = tanh((1.-radius*dist/nudging_radius)*20.) ! 1 inside circle, -1 outside 108 IF (c>0.99) c=1 109 IF (c<-0.99) c=-1 110 relax_coef = .5*(1.+c) ! rescale to [0,1] range ; ! 1 inside circle, 0 outside 111 IF(nudging_radius>0.) THEN 112 CALL dist_lonlat(lon, lat, center_lon, center_lat, dist) 113 c = tanh((1.-radius*dist/nudging_radius)*20.) ! 1 inside circle, -1 outside 114 IF (c>0.99) c=1 115 IF (c<-0.99) c=-1 116 relax_coef = .5*(1.+c) ! rescale to [0,1] range ; ! 1 inside circle, 0 outside 117 ELSE 118 c = 0. 119 END IF 120 121 relax_coef = 1. - (1.-relax_coef) * dt / (dt + nudging_relaxation_time) 111 122 END FUNCTION relax_coef 112 123 … … 139 150 END SUBROUTINE compute_target_center 140 151 152 SUBROUTINE compute_target_center2(theta_rhodz, target_theta_rhodz) 153 REAL(rstd), INTENT(OUT) :: target_theta_rhodz(iim*jjm,nqdyn) 154 REAL(rstd), INTENT(IN) :: theta_rhodz(iim*jjm,nqdyn) 155 INTEGER :: ij, iq 156 DO iq=1, nqdyn 157 DO ij=ij_begin_ext, ij_end_ext 158 target_theta_rhodz(ij,iq)=theta_rhodz(ij,iq) 159 END DO 160 END DO 161 END SUBROUTINE compute_target_center2 162 141 163 !----------------------------- Relax towards target ------------------------------ 142 164 … … 146 168 USE wind_mod 147 169 USE transfert_mod 148 USE time_mod 170 USE time_mod, ONLY : dt ! time step for a full RK step 149 171 USE vertical_remap_mod 150 172 USE compute_pression_mod, ONLY : pression_mid … … 157 179 TYPE(t_field),POINTER :: f_q(:) 158 180 TYPE(t_field),POINTER, SAVE :: f_T_guided(:), f_ulon_guided(:), f_ulat_guided(:),f_T_guided_interp(:), & 159 f_ulon_guided_interp(:),f_ulat_guided_interp(:) 181 f_ulon_guided_interp(:),f_ulat_guided_interp(:),f_ps_guided(:) 160 182 REAL(rstd), POINTER :: target_ue(:,:), ue(:,:), coef_e(:) 161 183 REAL(rstd), POINTER :: target_theta_rhodz(:,:,:), theta_rhodz(:,:,:), coef_i(:) 184 REAL(rstd), POINTER :: target_ps(:), ps2(:) 162 185 INTEGER :: ind 163 186 164 IF (abs(MOD(tt,REAL(nudging_time))-dt) < 1.0D-2) THEN 165 187 IF (abs(MOD(tt,REAL(nudging_time))-dt) < 1.0D-2) THEN 188 189 CALL allocate_field(f_ps_guided, field_t, type_real, name='nudging_ps') 190 CALL xios_read_field("ps_guided_read",f_ps_guided) 191 !f_ps = f_ps_guided !================================================>FIX 192 CALL transfert_request(f_ps_guided,req_i0) 193 CALL transfert_request(f_ps_guided,req_i1) 166 194 CALL allocate_field(f_T_guided, field_t, type_real, llm, name='nudging_T') 167 195 CALL allocate_field(f_T_guided_interp, field_t, type_real, llm, name='nudging_T') … … 172 200 CALL allocate_field(f_pmid_target,field_t,type_real,llm,name='target_pressure') 173 201 CALL xios_read_field("T_guided_read",f_T_guided) 174 CALL pression_mid(f_ps, f_pmid_target) 202 CALL pression_mid(f_ps, f_pmid_target) ! call ps nudging before this 175 203 CALL vertical_remap_extdata(f_T_guided,f_pmid_target,f_T_guided_interp) 176 204 CALL transfert_request(f_T_guided,req_i0) … … 191 219 CALL transfert_request(f_ulat_guided,req_i1) 192 220 CALL transfert_request(f_ulat_guided_interp,req_i1) 193 CALL xios_write_field("ulat_guided_out",f_ulat_guided) 221 !CALL xios_write_field("ulat_guided_out",f_ulat_guided) 222 CALL xios_write_field("ulat_guided_out",f_T_guided_interp) 194 223 CALL xios_write_field("ulon_guided_out",f_ulon_guided) 195 224 CALL xios_write_field("T_guided_out",f_T_guided) 225 CALL xios_write_field("PS_guided_out",f_ps_guided) 196 226 CALL ulonlat2un(f_ulon_guided_interp, f_ulat_guided,f_target_ue) 197 227 CALL deallocate_field(f_T_guided) … … 202 232 CALL deallocate_field(f_ulat_guided_interp) 203 233 CALL deallocate_field(f_pmid_target) 204 234 !CALL deallocate_field(f_ps_guided) 235 print*,"-----------------------nudging end------------------" 236 205 237 ENDIF 206 238 … … 217 249 target_theta_rhodz = f_target_theta_rhodz(ind) 218 250 theta_rhodz = f_theta_rhodz(ind) 219 CALL compute_guided_center(coef_i, target_theta_rhodz, theta_rhodz) 251 !CALL compute_guided_center(coef_i, target_theta_rhodz, theta_rhodz) 252 target_ps = f_ps_guided(ind) 253 ps2 = f_ps(ind) 254 CALL compute_guided_center2(coef_i, target_ps, ps2) 220 255 END DO 221 256 … … 253 288 END DO 254 289 END SUBROUTINE compute_guided_center 290 291 SUBROUTINE compute_guided_center2(coef_i, target_theta_rhodz, theta_rhodz) 292 REAL(rstd), INTENT(IN) :: coef_i(iim*jjm) 293 REAL(rstd), INTENT(IN) :: target_theta_rhodz(iim*jjm,nqdyn) 294 REAL(rstd), INTENT(INOUT) :: theta_rhodz(iim*jjm,nqdyn) 295 INTEGER :: ij, iq 296 DO iq=1, nqdyn 297 DO ij=ij_begin_ext, ij_end_ext 298 theta_rhodz(ij,iq) = theta_rhodz(ij,iq)*coef_i(ij) + & 299 target_theta_rhodz(ij,iq)*(1.-coef_i(ij)) 300 END DO 301 END DO 302 END SUBROUTINE compute_guided_center2 255 303 256 304 END MODULE nudging_mod -
codes/icosagcm/devel/src/time/timeloop_gcm.f90
r950 r968 167 167 168 168 CALL etat0(f_ps,f_mass,f_phis,f_theta_rhodz,f_u, f_geopot,f_W, f_q) 169 170 CALL init_guided(f_u,f_theta_rhodz )169 170 CALL init_guided(f_u,f_theta_rhodz,f_ps) 171 171 172 172 CALL transfert_request(f_phis,req_i0)
Note: See TracChangeset
for help on using the changeset viewer.