Changeset 179 for codes/icosagcm/trunk
- Timestamp:
- 12/13/13 18:33:56 (11 years ago)
- Location:
- codes/icosagcm/trunk/src
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/trunk/src/caldyn_gcm.f90
r174 r179 16 16 TYPE(t_field),POINTER :: f_geopot(:) 17 17 TYPE(t_field),POINTER :: f_wwuu(:) 18 TYPE(t_field),POINTER :: f_planetvel(:) 18 19 19 20 INTEGER :: caldyn_conserv … … 32 33 IMPLICIT NONE 33 34 CHARACTER(len=255) :: def 35 INTEGER :: ind 36 REAL(rstd),POINTER :: planetvel(:) 34 37 35 38 def='enstrophy' … … 48 51 49 52 CALL allocate_caldyn 50 53 54 DO ind=1,ndomain 55 CALL swap_dimensions(ind) 56 CALL swap_geometry(ind) 57 planetvel=f_planetvel(ind) 58 CALL compute_planetvel(planetvel) 59 END DO 60 51 61 END SUBROUTINE init_caldyn 52 62 53 63 SUBROUTINE allocate_caldyn 54 64 USE icosa … … 71 81 CALL allocate_field(f_geopot,field_t,type_real,llm+1,name='geopot') ! geopotential 72 82 CALL allocate_field(f_wwuu, field_u,type_real,llm+1,name='wwuu') 83 CALL allocate_field(f_planetvel, field_u,type_real, name='planetvel') ! planetary velocity at r=a 73 84 74 85 END SUBROUTINE allocate_caldyn … … 210 221 pk = f_pk(ind) 211 222 geopot = f_geopot(ind) 212 CALL compute_geopot(ps,mass,theta, pk,geopot)223 CALL compute_geopot(ps,mass,theta,u, pk,geopot) 213 224 hflux=f_hflux(ind) 214 225 convm = f_dmass(ind) … … 237 248 pk = f_pk(ind) 238 249 geopot = f_geopot(ind) 239 CALL compute_geopot(ps,mass,theta, pk,geopot)250 CALL compute_geopot(ps,mass,theta,u, pk,geopot) 240 251 hflux=f_hflux(ind) 241 252 convm = f_dmass(ind) … … 280 291 281 292 END SUBROUTINE caldyn 293 294 SUBROUTINE compute_planetvel(planetvel) 295 USE wind_mod 296 REAL(rstd),INTENT(OUT) :: planetvel(iim*3*jjm) 297 REAL(rstd) :: ulon(iim*3*jjm) 298 REAL(rstd) :: ulat(iim*3*jjm) 299 REAL(rstd) :: lon,lat 300 INTEGER :: ij 301 DO ij=ij_begin_ext,ij_end_ext 302 CALL xyz2lonlat(xyz_e(ij+u_right,:),lon,lat) 303 ulon(ij+u_right)=a*omega*cos(lat) 304 ulat(ij+u_right)=0 305 306 CALL xyz2lonlat(xyz_e(ij+u_lup,:),lon,lat) 307 ulon(ij+u_lup)=a*omega*cos(lat) 308 ulat(ij+u_lup)=0 309 310 CALL xyz2lonlat(xyz_e(ij+u_ldown,:),lon,lat) 311 ulon(ij+u_ldown)=a*omega*cos(lat) 312 ulat(ij+u_ldown)=0 313 END DO 314 CALL compute_wind2D_perp_from_lonlat_compound(ulon, ulat, planetvel) 315 END SUBROUTINE compute_planetvel 282 316 283 317 SUBROUTINE compute_pvort(ps,u,theta_rhodz, rhodz,theta,qu,qv) … … 334 368 DO l = ll_begin,ll_end 335 369 !DIR$ SIMD 336 DO ij=ij_begin_ext,ij_end_ext 370 DO ij=ij_begin_ext,ij_end_ext 337 371 etav= 1./Av(ij+z_up)*( ne_rup * u(ij+u_rup,l) * de(ij+u_rup) & 338 372 + ne_left * u(ij+t_rup+u_left,l) * de(ij+t_rup+u_left) & … … 370 404 END SUBROUTINE compute_pvort 371 405 372 SUBROUTINE compute_geopot(ps,rhodz,theta, pk,geopot)406 SUBROUTINE compute_geopot(ps,rhodz,theta,u, pk,geopot) 373 407 USE icosa 374 408 USE disvert_mod … … 380 414 REAL(rstd),INTENT(IN) :: rhodz(iim*jjm,llm) 381 415 REAL(rstd),INTENT(IN) :: theta(iim*jjm,llm) ! potential temperature 416 REAL(rstd),INTENT(IN) :: u(3*iim*jjm,llm) ! prognostic velocity 382 417 REAL(rstd),INTENT(INOUT) :: pk(iim*jjm,llm) ! Exner function 383 418 REAL(rstd),INTENT(INOUT) :: geopot(iim*jjm,llm+1) ! geopotential 384 419 420 REAL(rstd) :: urel(3*iim*jjm,llm) ! relative velocity 421 REAL(rstd) :: cor_NT(iim*jjm,llm) ! NT coriolis force u.(du/dPhi) 385 422 INTEGER :: i,j,ij,l 386 423 REAL(rstd) :: p_ik, exner_ik … … 474 511 REAL(rstd),INTENT(OUT) :: du(iim*3*jjm,llm) 475 512 513 REAL(rstd) :: urel(3*iim*jjm,llm) ! relative velocity 476 514 REAL(rstd) :: Ftheta(3*iim*jjm,llm) ! theta flux 477 515 REAL(rstd) :: berni(iim*jjm,llm) ! Bernoulli function … … 629 667 DO ij=ij_begin,ij_end 630 668 631 berni(ij,l) = pk(ij,l) +&669 berni(ij,l) = pk(ij,l) & 632 670 + 1/(4*Ai(ij))*(le(ij+u_right)*de(ij+u_right)*u(ij+u_right,l)**2 + & 633 671 le(ij+u_rup)*de(ij+u_rup)*u(ij+u_rup,l)**2 + & -
codes/icosagcm/trunk/src/etat0_williamson.f90
r164 r179 12 12 13 13 14 SUBROUTINE etat0_williamson(f_h,f_u) 14 SUBROUTINE etat0_williamson(f_h,f_u) ! Deprecated / to be removed 15 15 USE icosa 16 16 IMPLICIT NONE -
codes/icosagcm/trunk/src/wind.f90
r151 r179 184 184 END SUBROUTINE compute_wind_from_lonlat_compound 185 185 186 SUBROUTINE compute_wind2D_from_lonlat_compound(ulon, ulat, u) 187 USE icosa 188 189 IMPLICIT NONE 190 REAL(rstd) :: u(3*iim*jjm,3) 191 REAL(rstd) :: ulon(3*iim*jjm) 192 REAL(rstd) :: ulat(3*iim*jjm) 193 194 INTEGER :: i,j,ij 195 196 DO j=jj_begin-1,jj_end+1 197 DO i=ii_begin-1,ii_end+1 198 ij=(j-1)*iim+i 199 u(ij+u_right,:)=ulon(ij+u_right)*elon_e(ij+u_right,:)+ ulat(ij+u_right)*elat_e(ij+u_right,:) 200 u(ij+u_lup,:)=ulon(ij+u_lup)*elon_e(ij+u_lup,:) + ulat(ij+u_lup)*elat_e(ij+u_lup,:) 201 u(ij+u_ldown,:)=ulon(ij+u_ldown)*elon_e(ij+u_ldown,:) + ulat(ij+u_ldown)*elat_e(ij+u_ldown,:) 202 ENDDO 203 ENDDO 204 205 END SUBROUTINE compute_wind2D_from_lonlat_compound 206 186 207 SUBROUTINE compute_wind_perp_from_lonlat_compound(ulon, ulat, up) 187 208 USE icosa … … 210 231 END SUBROUTINE compute_wind_perp_from_lonlat_compound 211 232 233 SUBROUTINE compute_wind2D_perp_from_lonlat_compound(ulon, ulat, up) 234 USE icosa 235 236 IMPLICIT NONE 237 REAL(rstd) :: up(3*iim*jjm) 238 REAL(rstd) :: ulon(3*iim*jjm) 239 REAL(rstd) :: ulat(3*iim*jjm) 240 REAL(rstd) :: u(3*iim*jjm,3) 241 242 INTEGER :: i,j,ij 243 244 CALL compute_wind2D_from_lonlat_compound(ulon, ulat, u) 245 DO j=jj_begin-1,jj_end+1 246 DO i=ii_begin-1,ii_end+1 247 ij=(j-1)*iim+i 248 up(ij+u_right)=sum(u(ij+u_right,:)*ep_e(ij+u_right,:)) 249 up(ij+u_lup)=sum(u(ij+u_lup,:)*ep_e(ij+u_lup,:)) 250 up(ij+u_ldown)=sum(u(ij+u_ldown,:)*ep_e(ij+u_ldown,:)) 251 ENDDO 252 ENDDO 253 254 END SUBROUTINE compute_wind2D_perp_from_lonlat_compound 255 212 256 SUBROUTINE compute_wind_centered_lonlat_compound(uc, ulon, ulat) 213 257 USE icosa
Note: See TracChangeset
for help on using the changeset viewer.