- Timestamp:
- 08/23/18 17:38:00 (6 years ago)
- Location:
- codes/icosagcm/devel/src/diagnostics
- Files:
-
- 2 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) -
codes/icosagcm/devel/src/diagnostics/observable.f90
r714 r728 46 46 USE theta2theta_rhodz_mod 47 47 USE omega_mod 48 USE kinetic_mod 49 48 50 LOGICAL, INTENT(IN) :: init 49 51 INTEGER :: l … … 155 157 CALL vertical_interp(f_pmid,f_buf_i,f_buf_s,50000.) 156 158 CALL output_field("omega500",f_buf_s) 159 END IF 160 161 CALL kinetic(f_u, f_buf_i) 162 IF(init) THEN 163 CALL output_field("kinetic_trisk_init",f_buf_i) 164 ELSE 165 CALL output_field("kinetic_trisk",f_buf_i) 166 END IF 167 168 CALL kinetic_new(f_u, f_buf_v, f_buf_i) 169 IF(init) THEN 170 CALL output_field("kinetic_init",f_buf_i) 171 ELSE 172 CALL output_field("kinetic",f_buf_i) 157 173 END IF 158 174
Note: See TracChangeset
for help on using the changeset viewer.