/[lmdze]/trunk/dyn3d/Guide/Read_reanalyse/nat2gcm.f
ViewVC logotype

Diff of /trunk/dyn3d/Guide/Read_reanalyse/nat2gcm.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 134 by guez, Wed Apr 29 15:47:56 2015 UTC revision 172 by guez, Wed Sep 30 15:59:14 2015 UTC
# Line 1  Line 1 
1    subroutine nat2gcm(u,v,t,rh,pk,ucov,vcov,teta,q)
2    
3  !===========================================================================    ! Passage aux variables du modele (vents covariants, temperature
4        subroutine nat2gcm(u,v,t,rh,pk,ucov,vcov,teta,q)    ! potentielle et humidite specifique)
 !===========================================================================  
   
       use dimens_m  
       use paramet_m  
       use comconst  
       use disvert_m  
       use comgeom  
       use q_sat_m, only: q_sat  
       use guide_m  
       implicit none  
   
   
       real u(iip1,jjp1,llm),v(iip1,jjm,llm)  
       real t(iip1,jjp1,llm),pk(iip1,jjp1,llm),rh(iip1,jjp1,llm)  
       real ucov(iip1,jjp1,llm),vcov(iip1,jjm,llm)  
       real teta(iip1,jjp1,llm),q(iip1,jjp1,llm)  
   
       real pres(iip1,jjp1,llm),qsat(iip1,jjp1,llm)  
   
       real unskap  
   
       integer i,j,l  
   
   
       print*,'Entree dans nat2gcm'  
 !    ucov(:,:,:)=0.  
 !    do l=1,llm  
 !       ucov(:,2:jjm,l)=u(:,2:jjm,l)*cu_2d(:,2:jjm)  
 !    enddo  
 !    ucov(iip1,:,:)=ucov(1,:,:)  
   
 !    teta(:,:,:)=t(:,:,:)*cpp/pk(:,:,:)  
 !    teta(iip1,:,:)=teta(1,:,:)  
   
 !   calcul de ucov et de la temperature potentielle  
       do l=1,llm  
          do j=1,jjp1  
             do i=1,iim  
                ucov(i,j,l)=u(i,j,l)*cu_2d(i,j)  
                teta(i,j,l)=t(i,j,l)*cpp/pk(i,j,l)  
             enddo  
             ucov(iip1,j,l)=ucov(1,j,l)  
             teta(iip1,j,l)=teta(1,j,l)  
          enddo  
          do i=1,iip1  
             ucov(i,1,l)=0.  
             ucov(i,jjp1,l)=0.  
             teta(i,1,l)=teta(1,1,l)  
             teta(i,jjp1,l)=teta(1,jjp1,l)  
          enddo  
       enddo  
   
 !   calcul de ucov  
       do l=1,llm  
          do j=1,jjm  
             do i=1,iim  
                vcov(i,j,l)=v(i,j,l)*cv_2d(i,j)  
             enddo  
             vcov(iip1,j,l)=vcov(1,j,l)  
          enddo  
       enddo  
   
 !  Humidite relative -> specifique  
 !  -------------------------------  
       if (1.eq.0) then  
 !   FINALEMENT ON GUIDE EN HUMIDITE RELATIVE  
       print*,'calcul de unskap'  
       unskap   = 1./ kappa  
       print*,'calcul de pres'  
       pres(:,:,:)=preff*(pk(:,:,:)/cpp)**unskap  
       print*,'calcul de qsat'  
       qsat = q_sat(t, pres)  
       print*,'calcul de q'  
 !   ATTENTION : humidites relatives en %  
       rh(:,:,:)=max(rh(:,:,:)*0.01,1.e-6)  
       q(:,:,:)=qsat(:,:,:)*rh(:,:,:)  
       print*,'calcul de q OK'  
5    
6        endif    use dimens_m
7      use paramet_m
8      use comconst
9      use disvert_m
10      use comgeom
11      use q_sat_m, only: q_sat
12      use guide_m
13      implicit none
14    
15    
16      real u(iip1,jjp1,llm),v(iip1,jjm,llm)
17      real t(iip1,jjp1,llm),pk(iip1,jjp1,llm),rh(iip1,jjp1,llm)
18      real ucov(iip1,jjp1,llm),vcov(iip1,jjm,llm)
19      real teta(iip1,jjp1,llm),q(iip1,jjp1,llm)
20    
21      real pres(iip1,jjp1,llm),qsat(iip1,jjp1,llm)
22    
23      real unskap
24    
25      integer i,j,l
26    
27    
28      print*,'Entree dans nat2gcm'
29      !    ucov(:,:,:)=0.
30      !    do l=1,llm
31      !       ucov(:,2:jjm,l)=u(:,2:jjm,l)*cu_2d(:,2:jjm)
32      !    enddo
33      !    ucov(iip1,:,:)=ucov(1,:,:)
34    
35      !    teta(:,:,:)=t(:,:,:)*cpp/pk(:,:,:)
36      !    teta(iip1,:,:)=teta(1,:,:)
37    
38      !   calcul de ucov et de la temperature potentielle
39      do l=1,llm
40         do j=1,jjp1
41            do i=1,iim
42               ucov(i,j,l)=u(i,j,l)*cu_2d(i,j)
43               teta(i,j,l)=t(i,j,l)*cpp/pk(i,j,l)
44            enddo
45            ucov(iip1,j,l)=ucov(1,j,l)
46            teta(iip1,j,l)=teta(1,j,l)
47         enddo
48         do i=1,iip1
49            ucov(i,1,l)=0.
50            ucov(i,jjp1,l)=0.
51            teta(i,1,l)=teta(1,1,l)
52            teta(i,jjp1,l)=teta(1,jjp1,l)
53         enddo
54      enddo
55    
56      !   calcul de ucov
57      do l=1,llm
58         do j=1,jjm
59            do i=1,iim
60               vcov(i,j,l)=v(i,j,l)*cv_2d(i,j)
61            enddo
62            vcov(iip1,j,l)=vcov(1,j,l)
63         enddo
64      enddo
65    
66      !  Humidite relative -> specifique
67      !  -------------------------------
68      if (1.eq.0) then
69         !   FINALEMENT ON GUIDE EN HUMIDITE RELATIVE
70         print*,'calcul de unskap'
71         unskap   = 1./ kappa
72         print*,'calcul de pres'
73         pres(:,:,:)=preff*(pk(:,:,:)/cpp)**unskap
74         print*,'calcul de qsat'
75         qsat = q_sat(t, pres)
76         print*,'calcul de q'
77         !   ATTENTION : humidites relatives en %
78         rh(:,:,:)=max(rh(:,:,:)*0.01,1.e-6)
79         q(:,:,:)=qsat(:,:,:)*rh(:,:,:)
80         print*,'calcul de q OK'
81    
82      endif
83    
84        return  end subroutine nat2gcm
       end  
Legend:
Removed from v.134  
changed lines
  Added in v.172
  ViewVC Help
Powered by ViewVC 1.1.21