Changeset 252 for codes/icosagcm/trunk
- Timestamp:
- 07/23/14 14:06:47 (10 years ago)
- Location:
- codes/icosagcm/trunk/src
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/trunk/src/advect.f90
r186 r252 11 11 !========================================================================== 12 12 13 SUBROUTINE init_advect(normal,tangent, one_over_sqrt_leng)13 SUBROUTINE init_advect(normal,tangent,sqrt_leng) 14 14 IMPLICIT NONE 15 15 REAL(rstd),INTENT(OUT) :: normal(3*iim*jjm,3) 16 16 REAL(rstd),INTENT(OUT) :: tangent(3*iim*jjm,3) 17 REAL(rstd),INTENT(OUT) :: one_over_sqrt_leng(iim*jjm)17 REAL(rstd),INTENT(OUT) :: sqrt_leng(iim*jjm) 18 18 19 19 INTEGER :: ij … … 40 40 tangent(ij+u_ldown,:)=tangent(ij+u_ldown,:)/sqrt(sum(tangent(ij+u_ldown,:)**2)+1e-50) 41 41 42 one_over_sqrt_leng(ij) = 1./sqrt(max(sum((xyz_v(ij+z_up,:) - xyz_i(ij,:))**2),sum((xyz_v(ij+z_down,:) - xyz_i(ij,:))**2), &43 44 42 sqrt_leng(ij) = sqrt(max(sum((xyz_v(ij+z_up,:) - xyz_i(ij,:))**2),sum((xyz_v(ij+z_down,:) - xyz_i(ij,:))**2), & 43 sum((xyz_v(ij+z_rup,:) - xyz_i(ij,:))**2),sum((xyz_v(ij+z_rdown,:) - xyz_i(ij,:))**2), & 44 sum((xyz_v(ij+z_lup,:) - xyz_i(ij,:))**2),sum((xyz_v(ij+z_ldown,:) - xyz_i(ij,:))**2)) ) 45 45 ENDDO 46 46 … … 49 49 !======================================================================================= 50 50 51 SUBROUTINE compute_gradq3d(qi_in, one_over_sqrt_leng_in,gradq3d_out,xyz_i,xyz_v)51 SUBROUTINE compute_gradq3d(qi_in,sqrt_leng_in,gradq3d_out,xyz_i,xyz_v) 52 52 USE trace 53 53 USE omp_para 54 54 IMPLICIT NONE 55 55 REAL(rstd),INTENT(IN) :: qi_in(iim*jjm,llm) 56 REAL(rstd),INTENT(IN) :: one_over_sqrt_leng_in(iim*jjm)56 REAL(rstd),INTENT(IN) :: sqrt_leng_in(iim*jjm) 57 57 REAL(rstd),INTENT(IN) :: xyz_i(iim*jjm,3) 58 58 REAL(rstd),INTENT(IN) :: xyz_v(2*iim*jjm,3) … … 66 66 INTEGER :: ij,k,ind,l 67 67 REAL(rstd) :: qi(iim*jjm,llm) 68 REAL(rstd) :: one_over_sqrt_leng(iim*jjm)68 REAL(rstd) :: sqrt_leng(iim*jjm) 69 69 REAL(rstd) :: gradq3d(iim*jjm,llm,3) 70 70 REAL(rstd) :: detx,dety,detz,det … … 74 74 75 75 qi=qi_in 76 one_over_sqrt_leng=one_over_sqrt_leng_in76 sqrt_leng=sqrt_leng_in 77 77 78 78 CALL trace_start("compute_gradq3d1") … … 252 252 maggrd = gradq3d(ij,l,1)*gradq3d(ij,l,1) + gradq3d(ij,l,2)*gradq3d(ij,l,2) + gradq3d(ij,l,3)*gradq3d(ij,l,3) 253 253 maggrd = sqrt(maggrd) 254 maxq_c = qi(ij,l) + maggrd* one_over_sqrt_leng(ij)255 minq_c = qi(ij,l) - maggrd* one_over_sqrt_leng(ij)254 maxq_c = qi(ij,l) + maggrd*sqrt_leng(ij) 255 minq_c = qi(ij,l) - maggrd*sqrt_leng(ij) 256 256 maxq = max(qi(ij,l),qi(ij+t_right,l),qi(ij+t_lup,l),qi(ij+t_rup,l),qi(ij+t_left,l), & 257 257 qi(ij+t_rdown,l),qi(ij+t_ldown,l)) -
codes/icosagcm/trunk/src/advect_tracer.f90
r186 r252 8 8 TYPE(t_field),SAVE,POINTER :: f_gradq3d(:) 9 9 TYPE(t_field),SAVE,POINTER :: f_cc(:) ! starting point of backward-trajectory (Miura approach) 10 TYPE(t_field),SAVE,POINTER :: f_ one_over_sqrt_leng(:)10 TYPE(t_field),SAVE,POINTER :: f_sqrt_leng(:) 11 11 12 12 TYPE(t_message),SAVE :: req_u, req_cc, req_wfluxt, req_q, req_rhodz, req_gradq3d … … 28 28 REAL(rstd),POINTER :: tangent(:,:) 29 29 REAL(rstd),POINTER :: normal(:,:) 30 REAL(rstd),POINTER :: one_over_sqrt_leng(:)30 REAL(rstd),POINTER :: sqrt_leng(:) 31 31 INTEGER :: ind 32 32 … … 35 35 CALL allocate_field(f_gradq3d,field_t,type_real,llm,3, name='gradq3d') 36 36 CALL allocate_field(f_cc,field_u,type_real,llm,3, name='cc') 37 CALL allocate_field(f_ one_over_sqrt_leng,field_t,type_real, name='one_over_sqrt_leng')37 CALL allocate_field(f_sqrt_leng,field_t,type_real, name='sqrt_leng') 38 38 CALL allocate_field(f_dzqw, field_t, type_real, llm, name='dzqw') 39 39 CALL allocate_field(f_adzqw, field_t, type_real, llm, name='adzqw') … … 47 47 normal=f_normal(ind) 48 48 tangent=f_tangent(ind) 49 one_over_sqrt_leng=f_one_over_sqrt_leng(ind)50 CALL init_advect(normal,tangent, one_over_sqrt_leng)49 sqrt_leng=f_sqrt_leng(ind) 50 CALL init_advect(normal,tangent,sqrt_leng) 51 51 END DO 52 52 … … 66 66 TYPE(t_field),POINTER :: f_rhodz(:) ! mass field at beginning of macro time step 67 67 68 REAL(rstd),POINTER :: q(:,:,:), normal(:,:), tangent(:,:), one_over_sqrt_leng(:), gradq3d(:,:,:), cc(:,:,:)68 REAL(rstd),POINTER :: q(:,:,:), normal(:,:), tangent(:,:), sqrt_leng(:), gradq3d(:,:,:), cc(:,:,:) 69 69 REAL(rstd),POINTER :: hfluxt(:,:), wfluxt(:,:) 70 70 REAL(rstd),POINTER :: rhodz(:,:), u(:,:) … … 145 145 q = f_q(ind) 146 146 gradq3d = f_gradq3d(ind) 147 one_over_sqrt_leng=f_one_over_sqrt_leng(ind)148 CALL compute_gradq3d(q(:,:,k), one_over_sqrt_leng,gradq3d,xyz_i,xyz_v)147 sqrt_leng=f_sqrt_leng(ind) 148 CALL compute_gradq3d(q(:,:,k),sqrt_leng,gradq3d,xyz_i,xyz_v) 149 149 END DO 150 150
Note: See TracChangeset
for help on using the changeset viewer.