![(please configure the [header_logo] section in trac.ini)](/dynamico/chrome/site/your_project_logo.png){kind=logo}
Changeset 162 for codes/icosagcm/trunk/src/timeloop_gcm.f90
- Timestamp:
- 06/27/13 18:37:27 (11 years ago)
- File:
-
- 1 edited
-
codes/icosagcm/trunk/src/timeloop_gcm.f90 (modified) (17 diffs)
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/trunk/src/timeloop_gcm.f90
r159 r162 9 9 INTEGER :: itau_sync=10 10 10 11 TYPE(t_message) :: req_ps0, req_ theta_rhodz0, req_u0, req_q011 TYPE(t_message) :: req_ps0, req_mass0, req_theta_rhodz0, req_u0, req_q0 12 12 13 13 TYPE(t_field),POINTER :: f_q(:) … … 130 130 CALL allocate_field(f_hfluxt,field_u,type_real,llm) ! mass "fluxes" accumulated in time 131 131 CALL allocate_field(f_wflux,field_t,type_real,llm+1) ! vertical mass fluxes 132 CALL allocate_field(f_dmass,field_t,type_real,llm, name='dmass') 132 133 133 134 IF(caldyn_eta == eta_mass) THEN ! eta = mass coordinate (default) … … 136 137 CALL allocate_field(f_wfluxt,field_t,type_real,llm+1,name='wfluxt') 137 138 ! the following are unused but must point to something 138 f_massm1 => f_mass 139 f_dmass => f_mass 139 ! f_massm1 => f_mass 140 140 ELSE ! eta = Lagrangian vertical coordinate 141 CALL allocate_field(f_mass,field_t,type_real,llm) 142 CALL allocate_field(f_massm1,field_t,type_real,llm) 143 CALL allocate_field(f_dmass,field_t,type_real,llm) 141 CALL allocate_field(f_massm1,field_t,type_real,llm, name='massm1') 144 142 ! the following are unused but must point to something 145 143 f_wfluxt => f_wflux … … 147 145 f_psm1 => f_phis 148 146 END IF 149 150 147 151 148 def='runge_kutta' … … 197 194 198 195 CALL init_message(f_ps,req_i0,req_ps0) 196 CALL init_message(f_mass,req_i0,req_mass0) 199 197 CALL init_message(f_theta_rhodz,req_i0,req_theta_rhodz0) 200 198 CALL init_message(f_u,req_e0_vect,req_u0) … … 208 206 USE disvert_mod 209 207 USE caldyn_mod 210 USE caldyn_gcm_mod, ONLY : req_ps 208 USE caldyn_gcm_mod, ONLY : req_ps, req_mass 211 209 USE etat0_mod 212 210 USE guided_mod … … 237 235 CALL swap_dimensions(ind) 238 236 CALL swap_geometry(ind) 239 rhodz=f_rhodz(ind); ps=f_ps(ind) 240 CALL compute_rhodz(.TRUE., ps, rhodz) ! save rhodz for transport scheme before dynamics update ps 237 rhodz=f_rhodz(ind); mass=f_mass(ind); ps=f_ps(ind) 238 IF(caldyn_eta==eta_mass) THEN 239 CALL compute_rhodz(.TRUE., ps, rhodz) ! save rhodz for transport scheme before dynamics update ps 240 ELSE 241 rhodz(:,:)=mass(:,:) 242 END IF 241 243 END DO 242 244 fluxt_zero=.TRUE. … … 245 247 IF (MOD(it,itau_sync)==0) THEN 246 248 CALL send_message(f_ps,req_ps0) 249 CALL send_message(f_mass,req_mass0) 247 250 CALL send_message(f_theta_rhodz,req_theta_rhodz0) 248 251 CALL send_message(f_u,req_u0) 249 252 CALL send_message(f_q,req_q0) 250 253 CALL wait_message(req_ps0) 254 CALL wait_message(req_mass0) 251 255 CALL wait_message(req_theta_rhodz0) 252 256 CALL wait_message(req_u0) … … 266 270 CALL caldyn((stage==1) .AND. (MOD(it,itau_out)==0), & 267 271 f_phis,f_ps,f_mass,f_theta_rhodz,f_u, f_q, & 268 f_hflux, f_wflux, f_dps, f_d theta_rhodz, f_du)272 f_hflux, f_wflux, f_dps, f_dmass, f_dtheta_rhodz, f_du) 269 273 SELECT CASE (scheme) 270 274 CASE(euler) … … 326 330 CALL swap_dimensions(ind) 327 331 CALL swap_geometry(ind) 328 IF(with_dps) THEN 329 ps=f_ps(ind) ; dps=f_dps(ind) ; 330 331 IF (omp_first) THEN 332 DO j=jj_begin,jj_end 333 DO i=ii_begin,ii_end 334 ij=(j-1)*iim+i 335 ps(ij)=ps(ij)+dt*dps(ij) 336 ENDDO 337 ENDDO 338 ENDIF 339 340 hflux=f_hflux(ind); hfluxt=f_hfluxt(ind) 341 wflux=f_wflux(ind); wfluxt=f_wfluxt(ind) 342 CALL accumulate_fluxes(hflux,wflux,hfluxt,wfluxt,dt,fluxt_zero(ind)) 343 END IF 332 333 IF(with_dps) THEN ! update ps/mass 334 IF(caldyn_eta==eta_mass) THEN ! update ps 335 ps=f_ps(ind) ; dps=f_dps(ind) ; 336 IF (omp_first) THEN 337 DO j=jj_begin,jj_end 338 DO i=ii_begin,ii_end 339 ij=(j-1)*iim+i 340 ps(ij)=ps(ij)+dt*dps(ij) 341 ENDDO 342 ENDDO 343 ENDIF 344 ELSE ! update mass 345 mass=f_mass(ind) ; dmass=f_dmass(ind) ; 346 DO l=1,llm 347 DO j=jj_begin,jj_end 348 DO i=ii_begin,ii_end 349 ij=(j-1)*iim+i 350 mass(ij,l)=mass(ij,l)+dt*dmass(ij,l) 351 ENDDO 352 ENDDO 353 END DO 354 END IF 355 356 hflux=f_hflux(ind); hfluxt=f_hfluxt(ind) 357 wflux=f_wflux(ind); wfluxt=f_wfluxt(ind) 358 CALL accumulate_fluxes(hflux,wflux,hfluxt,wfluxt,dt,fluxt_zero(ind)) 359 END IF ! update ps/mass 344 360 345 361 u=f_u(ind) ; theta_rhodz=f_theta_rhodz(ind) … … 377 393 IF(caldyn_eta==eta_mass) THEN 378 394 IF (omp_first) THEN 395 379 396 DO ind=1,ndomain 380 397 CALL swap_dimensions(ind) 381 398 CALL swap_geometry(ind) 382 ps=f_ps(ind) 383 psm1=f_psm1(ind) 384 dps=f_dps(ind) 399 ps=f_ps(ind) ; psm1=f_psm1(ind) ; dps=f_dps(ind) 385 400 386 401 IF (stage==1) THEN ! first stage : save model state in XXm1 … … 402 417 ENDDO 403 418 ENDIF 404 405 419 CALL send_message(f_ps,req_ps) 420 421 ELSE ! Lagrangian coordinate, deal with mass 422 DO ind=1,ndomain 423 CALL swap_dimensions(ind) 424 CALL swap_geometry(ind) 425 mass=f_mass(ind); dmass=f_dmass(ind); massm1=f_massm1(ind) 426 427 IF (stage==1) THEN ! first stage : save model state in XXm1 428 DO l=ll_begin,ll_end 429 DO j=jj_begin,jj_end 430 DO i=ii_begin,ii_end 431 ij=(j-1)*iim+i 432 massm1(ij,l)=mass(ij,l) 433 ENDDO 434 ENDDO 435 ENDDO 436 END IF 437 438 ! updates are of the form x1 := x0 + tau*f(x1) 439 DO l=ll_begin,ll_end 440 DO j=jj_begin,jj_end 441 DO i=ii_begin,ii_end 442 ij=(j-1)*iim+i 443 mass(ij,l)=massm1(ij,l)+tau*dmass(ij,l) 444 ENDDO 445 ENDDO 446 ENDDO 447 END DO 448 CALL send_message(f_mass,req_mass) 449 406 450 END IF 407 451 … … 410 454 CALL swap_dimensions(ind) 411 455 CALL swap_geometry(ind) 412 ps=f_ps(ind) ; u=f_u(ind) ; theta_rhodz=f_theta_rhodz(ind) 413 psm1=f_psm1(ind) ; um1=f_um1(ind) ; theta_rhodzm1=f_theta_rhodzm1(ind) 414 dps=f_dps(ind) ; du=f_du(ind) ; dtheta_rhodz=f_dtheta_rhodz(ind) 456 u=f_u(ind) ; du=f_du(ind) ; um1=f_um1(ind) 457 theta_rhodz=f_theta_rhodz(ind) 458 theta_rhodzm1=f_theta_rhodzm1(ind) 459 dtheta_rhodz=f_dtheta_rhodz(ind) 415 460 416 461 IF (stage==1) THEN ! first stage : save model state in XXm1 417 418 462 DO l=ll_begin,ll_end 419 463 DO j=jj_begin,jj_end … … 427 471 ENDDO 428 472 ENDDO 429 430 IF(caldyn_eta==eta_lag) THEN ! mass = additional prognostic variable 431 DO l=ll_begin,ll_end 432 DO j=jj_begin,jj_end 433 DO i=ii_begin,ii_end 434 ij=(j-1)*iim+i 435 massm1(ij,l)=mass(ij,l) 436 ENDDO 437 ENDDO 438 ENDDO 439 END IF 440 441 END IF 442 ! updates are of the form x1 := x0 + tau*f(x1) 443 473 END IF 474 444 475 DO l=ll_begin,ll_end 445 476 DO j=jj_begin,jj_end … … 453 484 ENDDO 454 485 ENDDO 455 IF(caldyn_eta==eta_lag) THEN ! mass = additional prognostic variable 456 DO l=ll_begin,ll_end 457 DO j=jj_begin,jj_end 458 DO i=ii_begin,ii_end 459 ij=(j-1)*iim+i 460 mass(ij,l)=massm1(ij,l)+tau*dmass(ij,l) 461 ENDDO 462 ENDDO 463 ENDDO 464 END IF 465 486 466 487 IF(stage==nb_stage) THEN ! accumulate mass fluxes at last stage 467 488 hflux=f_hflux(ind); hfluxt=f_hfluxt(ind) … … 562 583 ENDDO 563 584 END IF 585 564 586 ELSE 565 587 … … 590 612 END SUBROUTINE accumulate_fluxes 591 613 614 FUNCTION maxval_i(p) 615 USE icosa 616 IMPLICIT NONE 617 REAL(rstd), DIMENSION(iim*jjm) :: p 618 REAL(rstd) :: maxval_i 619 INTEGER :: j, ij 620 621 maxval_i=p((jj_begin-1)*iim+ii_begin) 622 623 DO j=jj_begin-1,jj_end+1 624 ij=(j-1)*iim 625 maxval_i = MAX(maxval_i, MAXVAL(p(ij+ii_begin:ij+ii_end))) 626 END DO 627 END FUNCTION maxval_i 628 629 FUNCTION maxval_ik(p) 630 USE icosa 631 IMPLICIT NONE 632 REAL(rstd) :: p(iim*jjm, llm) 633 REAL(rstd) :: maxval_ik(llm) 634 INTEGER :: l,j, ij 635 636 DO l=1,llm 637 maxval_ik(l)=p((jj_begin-1)*iim+ii_begin,l) 638 DO j=jj_begin-1,jj_end+1 639 ij=(j-1)*iim 640 maxval_ik(l) = MAX(maxval_ik(l), MAXVAL(p(ij+ii_begin:ij+ii_end,l))) 641 END DO 642 END DO 643 END FUNCTION maxval_ik 644 592 645 END MODULE timeloop_gcm_mod
Note: See TracChangeset
for help on using the changeset viewer.
