Changeset 374
- Timestamp:
- 04/08/16 09:41:16 (8 years ago)
- Location:
- codes/icosagcm/trunk/src
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/trunk/src/observable.f90
r364 r374 4 4 PRIVATE 5 5 6 TYPE(t_field),POINTER, SAVE :: f_buf_i(:), f_buf_ulon(:), f_buf_ulat(:), f_buf_u3d(:) 6 TYPE(t_field),POINTER, SAVE :: f_buf_i(:), & 7 f_buf_uh(:), & ! horizontal velocity, different from prognostic velocity if NH 8 f_buf_ulon(:), f_buf_ulat(:), & 9 f_buf_u3d(:) ! unused, remove ? 7 10 TYPE(t_field),POINTER, SAVE :: f_buf1_i(:), f_buf2_i(:) 8 11 TYPE(t_field),POINTER, SAVE :: f_buf_v(:), f_buf_s(:), f_buf_p(:) … … 21 24 CALL allocate_field(f_buf_ulon,field_t,type_real,llm, name="buf_ulon") 22 25 CALL allocate_field(f_buf_ulat,field_t,type_real,llm, name="buf_ulat") 23 CALL allocate_field(f_buf_v, field_z,type_real,llm) 24 CALL allocate_field(f_buf_s, field_t,type_real) 26 CALL allocate_field(f_buf_uh, field_u,type_real,llm, name="buf_uh") 27 CALL allocate_field(f_buf_v, field_z,type_real,llm, name="buf_v") 28 CALL allocate_field(f_buf_s, field_t,type_real, name="buf_s") 25 29 26 30 CALL allocate_field(f_theta, field_t,type_real,llm, name='theta') ! potential temperature 27 31 END SUBROUTINE init_observable 28 32 29 SUBROUTINE write_output_fields_basic(f_ps, f_ u, f_q)33 SUBROUTINE write_output_fields_basic(f_ps, f_mass, f_geopot, f_u, f_W, f_q) 30 34 USE wind_mod 31 35 USE output_field_mod 32 36 USE omp_para 33 TYPE(t_field),POINTER :: f_ps(:), f_ u(:), f_q(:)37 TYPE(t_field),POINTER :: f_ps(:), f_mass(:), f_geopot(:), f_u(:), f_W(:), f_q(:) 34 38 ! IF (is_master) PRINT *,'CALL write_output_fields_basic' 35 CALL un2ulonlat(f_u, f_buf_ulon, f_buf_ulat) 39 CALL progonostic_vel_to_horiz(f_geopot, f_ps, f_mass, f_u, f_W, f_buf_uh, f_buf_i) 40 CALL transfert_request(f_buf_uh,req_e1_vect) 41 CALL output_field("uz",f_buf_i) 42 CALL un2ulonlat(f_buf_uh, f_buf_ulon, f_buf_ulat) 36 43 CALL output_field("ulon",f_buf_ulon) 37 44 CALL output_field("ulat",f_buf_ulat) … … 39 46 CALL output_field("Ai",geom%Ai) 40 47 ! CALL output_field("dps",f_dps) 41 !CALL output_field("mass",f_mass) 48 CALL output_field("mass",f_mass) 49 CALL output_field("geopot",f_geopot) 42 50 ! CALL output_field("dmass",f_dmass) 43 51 ! CALL output_field("vort",f_qv) … … 50 58 SUBROUTINE write_output_fields(f_ps, f_phis, f_dps, f_u, f_theta_rhodz, f_q, & 51 59 f_buf_i, f_buf_v, f_buf_i3, f_buf1_i, f_buf2_i, f_buf_s, f_buf_p) 52 USE icosa53 60 USE vorticity_mod 54 61 USE theta2theta_rhodz_mod … … 122 129 123 130 END SUBROUTINE write_output_fields 124 131 132 !------------------- Conversion from prognostic to observable variables ------------------ 133 134 SUBROUTINE progonostic_vel_to_horiz(f_geopot, f_ps, f_rhodz, f_u, f_W, f_uh, f_uz) 135 USE disvert_mod 136 TYPE(t_field), POINTER :: f_geopot(:), f_ps(:), f_rhodz(:), & 137 f_u(:), f_W(:), f_uz(:), & ! IN 138 f_uh(:) ! OUT 139 REAL(rstd),POINTER :: geopot(:,:), ps(:), rhodz(:,:), u(:,:), W(:,:), uh(:,:), uz(:,:) 140 INTEGER :: ind 141 142 DO ind=1,ndomain 143 IF (.NOT. assigned_domain(ind)) CYCLE 144 CALL swap_dimensions(ind) 145 CALL swap_geometry(ind) 146 geopot = f_geopot(ind) 147 rhodz = f_rhodz(ind) 148 u = f_u(ind) 149 W = f_W(ind) 150 uh = f_uh(ind) 151 IF(caldyn_eta==eta_mass) THEN 152 ps=f_ps(ind) 153 CALL compute_rhodz(.TRUE., ps, rhodz) 154 END IF 155 uz = f_uz(ind) 156 CALL compute_prognostic_vel_to_horiz(geopot,rhodz,u,W,uh,uz) 157 END DO 158 END SUBROUTINE progonostic_vel_to_horiz 159 160 SUBROUTINE compute_prognostic_vel_to_horiz(Phi, rhodz, u, W, uh, uz) 161 USE omp_para 162 REAL(rstd), INTENT(IN) :: Phi(iim*jjm,llm+1) 163 REAL(rstd), INTENT(IN) :: rhodz(iim*jjm,llm) 164 REAL(rstd), INTENT(IN) :: u(3*iim*jjm,llm) 165 REAL(rstd), INTENT(IN) :: W(iim*jjm,llm+1) 166 REAL(rstd), INTENT(OUT) :: uh(3*iim*jjm,llm) 167 REAL(rstd), INTENT(OUT) :: uz(iim*jjm,llm) 168 INTEGER :: ij,l 169 REAL(rstd) :: F_el(3*iim*jjm,llm+1) 170 REAL(rstd) :: uu_right, uu_lup, uu_ldown, W_el, DePhil 171 IF(hydrostatic) THEN 172 uh(:,:)=u(:,:) 173 uz(:,:)=0. 174 ELSE 175 DO l=ll_begin, ll_endp1 ! compute on l levels (interfaces) 176 DO ij=ij_begin_ext, ij_end_ext 177 ! Compute on edge 'right' 178 W_el = .5*( W(ij,l)+W(ij+t_right,l) ) 179 DePhil = ne_right*(Phi(ij+t_right,l)-Phi(ij,l)) 180 F_el(ij+u_right,l) = DePhil*W_el 181 ! Compute on edge 'lup' 182 W_el = .5*( W(ij,l)+W(ij+t_lup,l) ) 183 DePhil = ne_lup*(Phi(ij+t_lup,l)-Phi(ij,l)) 184 F_el(ij+u_lup,l) = DePhil*W_el 185 ! Compute on edge 'ldown' 186 W_el = .5*( W(ij,l)+W(ij+t_ldown,l) ) 187 DePhil = ne_ldown*(Phi(ij+t_ldown,l)-Phi(ij,l)) 188 F_el(ij+u_ldown,l) = DePhil*W_el 189 END DO 190 END DO 191 192 DO l=ll_begin, ll_end ! compute on k levels (full levels) 193 DO ij=ij_begin_ext, ij_end_ext 194 ! w = vertical momentum = g^-2*dPhi/dt = g*uz 195 uz(ij,l) = (.5*g)*(W(ij,l)+W(ij,l+1))/rhodz(ij,l) 196 ! uh = u-w.grad(Phi) = u - uz.grad(z) 197 uh(ij+u_right,l) = u(ij+u_right,l) - (F_el(ij+u_right,l)+F_el(ij+u_right,l+1)) / (rhodz(ij,l)+rhodz(ij+t_right,l)) 198 uh(ij+u_lup,l) = u(ij+u_lup,l) - (F_el(ij+u_lup,l)+F_el(ij+u_lup,l+1)) / (rhodz(ij,l)+rhodz(ij+t_lup,l)) 199 uh(ij+u_ldown,l) = u(ij+u_ldown,l) - (F_el(ij+u_ldown,l)+F_el(ij+u_ldown,l+1)) / (rhodz(ij,l)+rhodz(ij+t_ldown,l)) 200 END DO 201 END DO 202 203 END IF 204 END SUBROUTINE compute_prognostic_vel_to_horiz 205 125 206 SUBROUTINE thetarhodz2geopot(f_ps,f_phis,f_theta_rhodz, f_pks,f_p,f_theta,f_pk,f_phi) 126 207 USE field_mod -
codes/icosagcm/trunk/src/timeloop_gcm.f90
r372 r374 34 34 IF (.NOT. enable_io) itau_out=HUGE(itau_out) 35 35 36 def=' ARK2.3'36 def='RK2.5' 37 37 CALL getin('time_scheme',def) 38 38 SELECT CASE (TRIM(def)) … … 231 231 IF (mod(it,itau_out)==0 ) THEN 232 232 CALL transfert_request(f_u,req_e1_vect) 233 CALL write_output_fields_basic(f_ps, f_ u, f_q)233 CALL write_output_fields_basic(f_ps, f_mass, f_geopot, f_u, f_W, f_q) 234 234 ENDIF 235 235
Note: See TracChangeset
for help on using the changeset viewer.