Changeset 947 for codes/icosagcm/devel/src/dissip/nudging_mod.f90
- Timestamp:
- 07/10/19 16:31:55 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/devel/src/dissip/nudging_mod.f90
r946 r947 44 44 nudging_time=0. 45 45 CALL getin('nudging_time', nudging_time) 46 46 nudging_time = nudging_time/scale_factor 47 47 ! we should check that radius>0 48 48 CALL getin("guided_nudging_field",guided_nudging_field) … … 147 147 USE transfert_mod 148 148 USE time_mod 149 USE pression_mod 150 USE vertical_remap_mod 149 151 REAL(rstd), INTENT(IN):: tt 150 152 TYPE(t_field),POINTER :: f_ps(:) 153 TYPE(t_field),POINTER,SAVE :: f_pmid_target(:) 151 154 TYPE(t_field),POINTER :: f_phis(:) 152 155 TYPE(t_field),POINTER :: f_theta_rhodz(:) 153 156 TYPE(t_field),POINTER :: f_u(:) 154 157 TYPE(t_field),POINTER :: f_q(:) 155 TYPE(t_field),POINTER, SAVE :: f_T_guided(:), f_ulon_guided(:), f_ulat_guided(:),f_pressure_mid(:) 158 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(:) 156 160 REAL(rstd), POINTER :: target_ue(:,:), ue(:,:), coef_e(:) 157 161 REAL(rstd), POINTER :: target_theta_rhodz(:,:,:), theta_rhodz(:,:,:), coef_i(:) 158 162 INTEGER :: ind 159 160 IF (abs(MOD(tt,REAL(nudging_time))-dt) < 1.0D-2) THEN 161 163 164 IF (abs(MOD(tt,REAL(nudging_time))-dt) < 1.0D-2) THEN 165 162 166 CALL allocate_field(f_T_guided, field_t, type_real, llm, name='nudging_T') 167 CALL allocate_field(f_T_guided_interp, field_t, type_real, llm, name='nudging_T') 168 CALL allocate_field(f_ulon_guided_interp, field_t, type_real, llm, name='nudging_T') 169 CALL allocate_field(f_ulat_guided_interp, field_t, type_real, llm, name='nudging_T') 163 170 CALL allocate_field(f_ulon_guided, field_t, type_real, llm, name='nudging_ulon') 164 171 CALL allocate_field(f_ulat_guided, field_t, type_real, llm, name='nudging_ulat') 165 172 CALL allocate_field(f_pmid_target,field_t,type_real,llm,name='target_pressure') 166 173 CALL xios_read_field("T_guided_read",f_T_guided) 174 CALL pression_mid(f_ps, f_pmid_target) 175 CALL vertical_remap_extdata(f_T_guided,f_pmid_target,f_T_guided_interp) 167 176 CALL transfert_request(f_T_guided,req_i0) 168 CALL temperature2theta_rhodz(f_ps,f_T_guided,f_target_theta_rhodz) 177 CALL transfert_request(f_T_guided_interp,req_i0) 178 CALL transfert_request(f_T_guided,req_i1) 179 CALL transfert_request(f_T_guided_interp,req_i1) 180 CALL temperature2theta_rhodz(f_ps,f_T_guided_interp,f_target_theta_rhodz) 169 181 CALL xios_read_field("ulon_guided_read",f_ulon_guided) 170 182 CALL xios_read_field("ulat_guided_read",f_ulat_guided) 183 CALL vertical_remap_extdata(f_ulon_guided,f_pmid_target,f_ulon_guided_interp) 184 CALL vertical_remap_extdata(f_ulat_guided,f_pmid_target,f_ulat_guided_interp) 171 185 CALL transfert_request(f_ulon_guided,req_i0) 186 CALL transfert_request(f_ulon_guided_interp,req_i0) 172 187 CALL transfert_request(f_ulat_guided,req_i0) 188 CALL transfert_request(f_ulat_guided_interp,req_i0) 173 189 CALL transfert_request(f_ulon_guided,req_i1) 190 CALL transfert_request(f_ulon_guided_interp,req_i1) 174 191 CALL transfert_request(f_ulat_guided,req_i1) 192 CALL transfert_request(f_ulat_guided_interp,req_i1) 175 193 CALL xios_write_field("ulat_guided_out",f_ulat_guided) 176 194 CALL xios_write_field("ulon_guided_out",f_ulon_guided) 177 CALL ulonlat2un(f_ulon_guided, f_ulat_guided,f_target_ue)178 195 CALL xios_write_field("T_guided_out",f_T_guided) 196 CALL ulonlat2un(f_ulon_guided_interp, f_ulat_guided,f_target_ue) 179 197 CALL deallocate_field(f_T_guided) 198 CALL deallocate_field(f_T_guided_interp) 180 199 CALL deallocate_field(f_ulon_guided) 200 CALL deallocate_field(f_ulon_guided_interp) 181 201 CALL deallocate_field(f_ulat_guided) 202 CALL deallocate_field(f_ulat_guided_interp) 203 CALL deallocate_field(f_pmid_target) 182 204 183 205 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.