source: codes/icosagcm/trunk/src/disvert_ncar.f90 @ 25

Last change on this file since 25 was 25, checked in by dubos, 12 years ago

Minor changes :
caldyn_sw.f90, advect_tracer.f90
icosa_mod.f90 : added parameters for NCAR test cases needing global scope
guided_mod.f90 : CALL to guided_ncar now takes tt=it*dt instead of it as input

Significant changes :
timeloop_gcm.f90 : re-activated CALL to advection scheme
disvert_ncar.f90,
etat0_ncar.f90
guided_ncar_mod.f90 : simplification, introduced several getin(...), update due to recent changes in advection test cases (deformational flow, Hadley cell)
run_adv.def : new keys, reorganized for legibility

Tests :
icosa_gcm.exe tested with ncar_adv_shape=const and ncar_adv_wind=solid,deform,hadley.
q1=1 maintained to machine accuracy. Surface pressure slightly oscillates as expected.

FIXME : Tests by Sarvesh with revision 24 show incorrect advection of cosine bell by solid-body rotation. Not fixed.

File size: 1.7 KB
Line 
1  MODULE disvert_ncar_mod
2  USE icosa
3 
4  REAL(rstd), SAVE, ALLOCATABLE,TARGET :: ap(:)
5  REAL(rstd), SAVE, ALLOCATABLE,TARGET :: bp(:)
6  REAL(rstd), SAVE, ALLOCATABLE,TARGET :: presnivs(:)
7
8CONTAINS
9!=========================================================================
10
11  SUBROUTINE init_disvert
12  USE icosa
13  IMPLICIT NONE
14 
15    ALLOCATE(ap(llm+1))
16    ALLOCATE(bp(llm+1))
17    ALLOCATE(presnivs(llm))
18   
19    CALL disvert(ap,bp,presnivs)   
20
21  END SUBROUTINE init_disvert 
22
23  SUBROUTINE disvert(ap,bp,presnivs)
24  USE icosa
25  IMPLICIT NONE
26  REAL(rstd),INTENT(OUT) :: ap(:)
27  REAL(rstd),INTENT(OUT) :: bp(:)
28  REAL(rstd),INTENT(OUT) :: presnivs(:)
29  ! reads from run.def : ncar_dz, ncar_T0, ncar_p0, ncar_disvert_c
30  INTEGER :: l,cindx
31  REAL(rstd) :: H, eta_top, eta
32
33  ncar_dz=400 ; CALL getin('ncar_dz',ncar_dz);
34
35! SELECT CASE(
36! pressure profile depends on test case
37! coded here for 1-x (transport)
38
39  ncar_T0=300; CALL getin('ncar_T0',ncar_T0)
40  ncar_p0=1e5; CALL getin('ncar_p0',ncar_p0)
41  cindx=1 ; CALL getin('ncar_disvert_c',cindx)
42
43  H = ncar_T0*cpp*kappa/g ! height scale R.T0/g with R=cpp*kappa
44  eta_top = exp(-llm*ncar_dz/H)
45 
46  do l = 1,llm+1
47     eta = exp(-(l-1)*ncar_dz/H)
48     bp(l) = ((eta - eta_top)/(1 - eta_top))**cindx
49     ap(l) = ncar_p0 * ( eta - bp(l) )
50  ENDDO
51  bp(1)=1.
52  ap(1)=0.
53  bp(llm+1) = 0
54 
55  DO l = 1, llm
56     presnivs(l) = 0.5 *( ap(l)+bp(l)*ncar_p0 + ap(l+1)+bp(l+1)*ncar_p0 )
57  ENDDO
58
59  PRINT *, 'Vertical placement of model levels according to DCMIP Appendix E.3'
60  PRINT *, 'Parameters : ncar_dz=', ncar_dz, '  ncar_p0=',ncar_p0, '  ncar_disvert_c=',cindx
61  PRINT *, 'Isothermal amtosphere with ncar_T0=',ncar_T0 
62
63END SUBROUTINE disvert
64
65END  MODULE disvert_ncar_mod
Note: See TracBrowser for help on using the repository browser.