Changeset 947 for codes/icosagcm/devel/src
- Timestamp:
- 07/10/19 16:31:55 (5 years ago)
- Location:
- codes/icosagcm/devel/src
- Files:
-
- 2 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 -
codes/icosagcm/devel/src/vertical/vertical_remap.f90
r913 r947 4 4 IMPLICIT NONE 5 5 PRIVATE 6 PUBLIC vertical_remap_extdata,compute_vertical_remap_extdata 6 7 7 8 PUBLIC :: vertical_remap … … 107 108 END SUBROUTINE compute_vertical_remap 108 109 110 SUBROUTINE vertical_remap_extdata(field_in,f_target_pressure,field_out) 111 USE icosa 112 USE pression_mod 113 USE omp_para 114 USE disvert_mod, ONLY : presnivs 115 116 IMPLICIT NONE 117 TYPE(t_field),POINTER :: field_in(:) 118 TYPE(t_field),POINTER :: field_out(:) 119 TYPE(t_field),POINTER :: f_target_pressure(:) 120 121 REAL(rstd),POINTER :: target_pressure(:,:) 122 REAL(rstd),POINTER :: in(:,:) 123 REAL(rstd),POINTER :: out(:,:) 124 INTEGER :: ind 125 126 DO ind=1,ndomain 127 IF (.NOT. assigned_domain(ind)) CYCLE 128 CALL swap_dimensions(ind) 129 CALL swap_geometry(ind) 130 in=field_in(ind) 131 out=field_out(ind) 132 target_pressure=f_target_pressure(ind) 133 CALL compute_vertical_remap_extdata(in,target_pressure,out) 134 ENDDO 135 136 END SUBROUTINE vertical_remap_extdata 137 138 SUBROUTINE compute_vertical_remap_extdata(in,target_pressure,out2d_press) 139 USE omp_para 140 USE disvert_mod, ONLY : presnivs 141 IMPLICIT NONE 142 REAL(rstd),INTENT(IN) :: in(:,:) 143 REAL(rstd),INTENT(IN) :: target_pressure(iim*jjm,llm+1) 144 REAL(rstd),INTENT(OUT) :: out2d_press(iim*jjm,llm+1) 145 REAL(rstd) :: coeff, target_pval,testp1,testp2 146 INTEGER :: i,j,ij,l,n,nb_level 147 INTEGER :: a 148 INTEGER :: b 149 LOGICAL :: positive 150 151 nb_level=size(presnivs) 152 !$OMP BARRIER 153 IF (is_omp_level_master) THEN 154 DO l=1,llm 155 DO j=jj_begin,jj_end 156 DO i=ii_begin,ii_end 157 ij=(j-1)*iim+i 158 target_pval=target_pressure(ij,l) 159 a=0 160 DO n=1,nb_level-1 161 IF ( (target_pval<=presnivs(n) .AND. target_pval>=presnivs(n+1))) THEN 162 testp1=presnivs(n); testp2=presnivs(n+1) 163 a=n ; b=n+1 ; EXIT 164 ENDIF 165 ENDDO 166 IF (a==0) THEN 167 IF (target_pval>=presnivs(1)) THEN 168 a=1 ; b=2 169 ELSE 170 a=nb_level-1 ; b=nb_level 171 ENDIF 172 ENDIF 173 174 coeff=(target_pval-presnivs(a))/(presnivs(a)-presnivs(b)) 175 out2d_press(ij,l)=in(ij,a)+coeff*(in(ij,a)-in(ij,b)) 176 ENDDO 177 ENDDO 178 ENDDO 179 180 ENDIF 181 !$OMP BARRIER 182 183 END SUBROUTINE compute_vertical_remap_extdata 184 185 186 109 187 END MODULE vertical_remap_mod
Note: See TracChangeset
for help on using the changeset viewer.