source: codes/icosagcm/devel/src/diagnostics/compute_temperature.F90 @ 914

Last change on this file since 914 was 914, checked in by dubos, 5 years ago

devel : moved diagnostics of temperature and velocity into separate modules
File size: 2.4 KB
Line 
1MODULE compute_temperature_mod
2  USE icosa
3  IMPLICIT NONE
4  PRIVATE
5  SAVE
6
7  PUBLIC :: temperature, compute_temperature
8
9CONTAINS
10 
11  SUBROUTINE temperature(f_pmid,f_q,f_temp)
12    TYPE(t_field), POINTER :: f_pmid(:)         ! IN
13    TYPE(t_field), POINTER :: f_q(:)            ! IN
14    TYPE(t_field), POINTER :: f_temp(:)         ! INOUT
15   
16    REAL(rstd), POINTER :: pmid(:,:)
17    REAL(rstd), POINTER :: q(:,:,:)
18    REAL(rstd), POINTER :: temp(:,:)
19    INTEGER :: ind
20   
21    DO ind=1,ndomain
22       IF (.NOT. assigned_domain(ind)) CYCLE
23       CALL swap_dimensions(ind)
24       CALL swap_geometry(ind)
25       pmid=f_pmid(ind)
26       q=f_q(ind)
27       temp=f_temp(ind)
28       CALL compute_temperature(pmid,q,temp)
29    END DO
30  END SUBROUTINE temperature
31 
32  SUBROUTINE compute_temperature(pmid,q,temp)
33    USE omp_para
34    REAL(rstd),INTENT(IN)    :: pmid(iim*jjm,llm)
35    REAL(rstd),INTENT(IN)    :: q(iim*jjm,llm,nqtot)
36    REAL(rstd),INTENT(INOUT) :: temp(iim*jjm,llm)
37
38    REAL(rstd) :: Rd, p_ik, theta_ik, temp_ik, qv, chi, Rmix
39    INTEGER :: ij,l
40
41    Rd = kappa*cpp
42    DO l=ll_begin,ll_end
43       DO ij=ij_begin,ij_end
44          p_ik = pmid(ij,l)
45          theta_ik = temp(ij,l)
46          qv = q(ij,l,1) ! water vapor mixing ratio = mv/md
47          SELECT CASE(caldyn_thermo)
48          CASE(thermo_theta)
49             temp_ik = theta_ik*((p_ik/preff)**kappa)
50          CASE(thermo_entropy)
51             temp_ik = Treff*exp((theta_ik + Rd*log(p_ik/preff))/cpp)
52          CASE(thermo_moist)
53             Rmix = Rd+qv*Rv
54             chi = ( theta_ik + Rmix*log(p_ik/preff) ) / (cpp + qv*cppv) ! log(T/Treff)
55             temp_ik = Treff*exp(chi)
56          END SELECT
57          IF(physics_thermo==thermo_fake_moist) temp_ik=temp_ik/(1+0.608*qv)
58          temp(ij,l)=temp_ik
59       END DO
60    END DO
61  END SUBROUTINE compute_temperature
62
63  SUBROUTINE Tv2T(f_Tv, f_q, f_T)
64    TYPE(t_field), POINTER :: f_TV(:)
65    TYPE(t_field), POINTER :: f_q(:)
66    TYPE(t_field), POINTER :: f_T(:)
67   
68    REAL(rstd),POINTER :: Tv(:,:), q(:,:,:), T(:,:)
69    INTEGER :: ind
70   
71    DO ind=1,ndomain
72       IF (.NOT. assigned_domain(ind)) CYCLE
73       CALL swap_dimensions(ind)
74       CALL swap_geometry(ind)
75       Tv=f_Tv(ind)
76       T=f_T(ind)
77       SELECT CASE(physics_thermo)
78       CASE(thermo_dry)
79          T=Tv
80       CASE(thermo_fake_moist)
81          q=f_q(ind)
82          T=Tv/(1+0.608*q(:,:,1))
83       END SELECT
84    END DO
85  END SUBROUTINE Tv2T
86
87END MODULE compute_temperature_mod
Note: See TracBrowser for help on using the repository browser.