Changeset 728 for codes/icosagcm/devel/src/diagnostics/kinetic.f90
- Timestamp:
- 08/23/18 17:38:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/devel/src/diagnostics/kinetic.f90
r533 r728 3 3 PRIVATE 4 4 5 PUBLIC :: kinetic, kinetic_ v, kinetic_new, gradient5 PUBLIC :: kinetic, kinetic_new, gradient 6 6 7 7 CONTAINS … … 18 18 19 19 CALL transfert_request(f_ue,req_e1_vect) 20 CALL transfert_request(f_ue,req_e1_vect)21 20 22 21 DO ind=1,ndomain … … 26 25 ue=f_ue(ind) 27 26 Ki=f_Ki(ind) 28 CALL compute_kinetic (ue, Ki)27 CALL compute_kinetic_trisk(ue, Ki) 29 28 ENDDO 30 29 END SUBROUTINE kinetic 31 30 32 SUBROUTINE kinetic_new(f_ue,f_K i)31 SUBROUTINE kinetic_new(f_ue,f_Kv,f_Ki) 33 32 USE icosa 34 33 IMPLICIT NONE 35 34 TYPE(t_field), POINTER :: f_ue(:) 35 TYPE(t_field), POINTER :: f_Kv(:) 36 36 TYPE(t_field), POINTER :: f_Ki(:) 37 37 38 38 REAL(rstd), POINTER :: ue(:,:) 39 REAL(rstd), POINTER :: Kv(:,:) 39 40 REAL(rstd), POINTER :: Ki(:,:) 40 41 INTEGER :: ind 41 42 42 CALL transfert_request(f_ue,req_e1_vect)43 CALL transfert_request(f_ue,req_e1_vect)44 45 DO ind=1,ndomain46 IF (.NOT. assigned_domain(ind)) CYCLE47 CALL swap_dimensions(ind)48 CALL swap_geometry(ind)49 ue=f_ue(ind)50 Ki=f_Ki(ind)51 CALL compute_Ki_new(ue, Ki)52 ENDDO53 END SUBROUTINE kinetic_new54 55 SUBROUTINE kinetic_v(f_ue,f_Kv)56 USE icosa57 IMPLICIT NONE58 TYPE(t_field), POINTER :: f_ue(:)59 TYPE(t_field), POINTER :: f_Kv(:)60 61 REAL(rstd), POINTER :: ue(:,:)62 REAL(rstd), POINTER :: Kv(:,:)63 INTEGER :: ind64 65 CALL transfert_request(f_ue,req_e1_vect)66 43 CALL transfert_request(f_ue,req_e1_vect) 67 44 … … 73 50 Kv=f_Kv(ind) 74 51 CALL compute_kv(ue, Kv) 75 ENDDO 76 END SUBROUTINE kinetic_v 52 ENDDO 53 54 CALL transfert_request(f_Kv,req_z1_scal) 55 56 DO ind=1,ndomain 57 IF (.NOT. assigned_domain(ind)) CYCLE 58 CALL swap_dimensions(ind) 59 CALL swap_geometry(ind) 60 Kv=f_Kv(ind) 61 Ki=f_Ki(ind) 62 CALL compute_Ki_from_Kv(Kv, Ki) 63 ENDDO 64 END SUBROUTINE kinetic_new 77 65 78 SUBROUTINE compute_kinetic (ue, Ki)66 SUBROUTINE compute_kinetic_trisk(ue, Ki) 79 67 USE icosa 80 68 USE omp_para … … 99 87 ENDDO 100 88 ENDDO 101 END SUBROUTINE compute_kinetic 89 END SUBROUTINE compute_kinetic_trisk 102 90 103 91 SUBROUTINE compute_kv(ue, Kv) … … 113 101 114 102 DO l=ll_begin,ll_end 103 Kv(:,l)=0. 115 104 DO ij=ij_begin,ij_end 116 105 Kv(ij+z_up,l) = (radius**2/Av(ij+z_up))*( & … … 127 116 END SUBROUTINE compute_kv 128 117 129 SUBROUTINE compute_Ki_ new(ue, Ki)118 SUBROUTINE compute_Ki_from_Kv(Kv, Ki) 130 119 USE icosa 131 120 USE omp_para 132 121 IMPLICIT NONE 133 REAL(rstd),INTENT(IN) :: ue(3*iim*jjm,llm)134 122 REAL(rstd),INTENT(OUT):: Ki(iim*jjm,llm) 135 REAL(rstd) :: Kv(2*iim*jjm,llm) 136 INTEGER :: ij,l, u_up, u_down 137 138 CALL compute_kv(ue,Kv) 123 REAL(rstd), INTENT(IN) :: Kv(2*iim*jjm,llm) 124 INTEGER :: ij,l 139 125 140 126 DO l=ll_begin,ll_end … … 148 134 END DO 149 135 END DO 150 END SUBROUTINE compute_Ki_ new136 END SUBROUTINE compute_Ki_from_Kv 151 137 152 138 SUBROUTINE gradient(f_berni, f_du)
Note: See TracChangeset
for help on using the changeset viewer.