source: codes/icosagcm/trunk/src/vertical/disvert_dcmip200.f90

Last change on this file was 548, checked in by dubos, 7 years ago

trunk : reorganize source tree

File size: 1.9 KB
Line 
1  MODULE disvert_dcmip200_mod
2  USE icosa
3 
4  REAL(rstd), SAVE, ALLOCATABLE,TARGET :: ap(:)
5!$OMP THREADPRIVATE(ap)
6  REAL(rstd), SAVE, ALLOCATABLE,TARGET :: bp(:)
7!$OMP THREADPRIVATE(bp)
8  REAL(rstd), SAVE, ALLOCATABLE,TARGET :: presnivs(:)
9!$OMP THREADPRIVATE(presnivs)
10
11CONTAINS
12!=========================================================================
13
14  SUBROUTINE init_disvert
15  USE icosa
16  USE mpipara
17  IMPLICIT NONE
18 
19    ALLOCATE(ap(llm+1))
20    ALLOCATE(bp(llm+1))
21    ALLOCATE(presnivs(llm))
22   
23    CALL disvert(ap,bp,presnivs)   
24
25  END SUBROUTINE init_disvert 
26
27  SUBROUTINE disvert(ap,bp,presnivs)
28  USE icosa
29  USE mpipara
30  IMPLICIT NONE
31  REAL(rstd),INTENT(OUT) :: ap(:)
32  REAL(rstd),INTENT(OUT) :: bp(:)
33  REAL(rstd),INTENT(OUT) :: presnivs(:)
34  ! reads from run.def : ncar_dz, ncar_T0, ncar_p0, ncar_disvert_c
35  INTEGER :: l,cindx
36  REAL(rstd) ::  eta_top, eta
37  REAL(rstd),PARAMETER :: N=0.01         ! Brunt-Vaisala frequency (s-1)
38  REAL(rstd),PARAMETER :: T0=300.       ! Surface temperature at the equator (K)
39  REAL(rstd) :: Rd       
40  REAL(rstd), PARAMETER :: Gamma=0.0065       
41
42  Rd=cpp*kappa
43  ncar_dz=400 ; CALL getin('ncar_dz',ncar_dz);
44  cindx=1 ; CALL getin('ncar_disvert_c',cindx)
45
46 
47   
48  eta_top = (1-Gamma/T0*llm*ncar_dz)**(g/(Rd*Gamma)) 
49  do l = 1,llm+1
50     eta = (1-Gamma/T0*(l-1)*ncar_dz)**(g/(Rd*Gamma))
51     PRINT *,'eta ->', eta
52     bp(l) = ((eta - eta_top)/(1 - eta_top))**cindx
53     ap(l) = preff * ( eta - bp(l) )
54  ENDDO
55  bp(1)=1.
56  ap(1)=0.
57  bp(llm+1) = 0
58 
59  DO l = 1, llm
60     presnivs(l) = 0.5 *( ap(l)+bp(l)*preff + ap(l+1)+bp(l+1)*preff )
61  ENDDO
62
63!$OMP MASTER 
64  IF (is_mpi_root) PRINT *, 'Vertical placement of model levels according to DCMIP Appendix E.3'
65  IF (is_mpi_root) PRINT *, 'Parameters : ncar_dz=', ncar_dz, '  ncar_p0=',ncar_p0, '  ncar_disvert_c=',cindx
66  IF (is_mpi_root) PRINT *, 'Isothermal amtosphere with ncar_T0=',ncar_T0 
67!$OMP END MASTER 
68
69END SUBROUTINE disvert
70
71END  MODULE disvert_dcmip200_mod
Note: See TracBrowser for help on using the repository browser.