source: codes/icosagcm/trunk/src/disvert_std.f90 @ 191

Last change on this file since 191 was 186, checked in by ymipsl, 10 years ago

Add new openMP parallelism based on distribution of domains on threads. There is no more limitation of number of threads by MPI process.

YM
File size: 2.0 KB
Line 
1MODULE disvert_std_mod
2  USE icosa
3  REAL(rstd), SAVE, ALLOCATABLE,TARGET :: ap(:)
4!$OMP THREADPRIVATE(ap)
5  REAL(rstd), SAVE, ALLOCATABLE,TARGET :: bp(:)
6!$OMP THREADPRIVATE(bp)
7  REAL(rstd), SAVE, ALLOCATABLE,TARGET :: presnivs(:)
8!$OMP THREADPRIVATE(presnivs)
9
10CONTAINS
11
12  SUBROUTINE init_disvert
13  USE icosa
14  IMPLICIT NONE
15 
16    ALLOCATE(ap(llm+1))
17    ALLOCATE(bp(llm+1))
18    ALLOCATE(presnivs(llm))
19
20    CALL disvert(ap,bp,presnivs)   
21
22  END SUBROUTINE init_disvert 
23
24
25  SUBROUTINE disvert(ap,bp,presnivs)
26  USE icosa
27  USE mpipara
28  IMPLICIT NONE
29  REAL(rstd),INTENT(OUT) :: ap(:)
30  REAL(rstd),INTENT(OUT) :: bp(:)
31  REAL(rstd),INTENT(OUT) :: presnivs(:)
32 
33  REAL(rstd) :: dsig(llm)
34  REAL(rstd) :: sig(llm+1)
35  REAL(rstd) :: snorm
36  INTEGER :: l
37 
38    snorm  = 0.
39    DO l = 1, llm
40      dsig(l) = 1.0 + 7.0 * SIN( Pi*(l-0.5)/(llm+1) )**2
41      snorm = snorm + dsig(l)
42    ENDDO   
43   
44    DO l = 1, llm
45      dsig(l) = dsig(l)/snorm
46    ENDDO
47
48    sig(llm+1) = 0.
49    DO l = llm, 1, -1
50      sig(l) = sig(l+1) + dsig(l)
51    ENDDO
52
53    bp(llm+1) =   0.
54    DO l = 1, llm
55      bp(l) = EXP( 1. -1./( sig(l)*sig(l)) )
56      ap(l) = pa * ( sig(l) - bp(l) )
57    ENDDO
58    bp(1)=1.
59    ap(1)=0.
60    ap(llm+1) = pa * ( sig(llm+1) - bp(llm+1) )
61   
62    IF (is_mpi_root) PRINT*,'ap',ap
63    IF (is_mpi_root) PRINT*,'bp',bp
64   
65    IF (is_mpi_root) PRINT*, 'Niveaux de pressions approximatifs aux centres des'
66    IF (is_mpi_root) PRINT*, 'couches calcules pour une pression de surface =', preff
67    IF (is_mpi_root) PRINT*, 'et altitudes equivalentes pour une hauteur d echelle de'
68    IF (is_mpi_root) PRINT*, '8km'
69   
70    DO l = 1, llm
71      presnivs(l) = 0.5 *( ap(l)+bp(l)*preff + ap(l+1)+bp(l+1)*preff )
72 
73      IF (is_mpi_root) PRINT*, 'PRESNIVS(',l,')=',presnivs(l),'  Z ~ ',log(preff/presnivs(l))*8.,       &
74                               ' DZ ~ ',8.*log((ap(l)+bp(l)*preff)/ max(ap(l+1)+bp(l+1)*preff,1.e-10))
75    ENDDO
76 
77  END SUBROUTINE disvert
78 
79END MODULE disvert_std_mod
Note: See TracBrowser for help on using the repository browser.