Changeset 1742 for LMDZ5/trunk/libf/phylmd/cv30_routines.F
- Timestamp:
- Apr 5, 2013, 1:49:35 PM (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/trunk/libf/phylmd/cv30_routines.F
r1403 r1742 1831 1831 : ,th,tv,lv,cpn,ep,sigp,clw 1832 1832 : ,m,ment,elij,delt,plcl 1833 : ,mp,rp,up,vp,trap,wt,water,evap,b) 1833 : ,mp,rp,up,vp,trap,wt,water,evap,b ! RomP-jyg 1834 : ,wdtrainA,wdtrainM) ! 26/08/10 RomP-jyg 1834 1835 implicit none 1835 1836 … … 1857 1858 real trap(nloc,na,ntra) 1858 1859 real b(nloc,na) 1860 ! 25/08/10 - RomP---- ajout des masses precipitantes ejectees 1861 ! lascendance adiabatique et des flux melanges Pa et Pm. 1862 ! Distinction des wdtrain 1863 ! Pa = wdtrainA Pm = wdtrainM 1864 real wdtrainA(nloc,na), wdtrainM(nloc,na) 1859 1865 1860 1866 c local variables … … 1898 1904 c enddo 1899 1905 c enddo 1900 1906 !! RomP >>> 1907 do i=1,nd 1908 do il=1,ncum 1909 wdtrainA(il,i)=0.0 1910 wdtrainM(il,i)=0.0 1911 enddo 1912 enddo 1913 !! RomP <<< 1901 1914 c 1902 1915 c *** check whether ep(inb)=0, if so, skip precipitating *** … … 1935 1948 if (cvflag_grav) then 1936 1949 wdtrain(il)=grav*ep(il,i)*m(il,i)*clw(il,i) 1950 wdtrainA(il,i) = wdtrain(il)/grav ! Pa 26/08/10 RomP 1937 1951 else 1938 1952 wdtrain(il)=10.0*ep(il,i)*m(il,i)*clw(il,i) 1953 wdtrainA(il,i) = wdtrain(il)/10. ! Pa 26/08/10 RomP 1939 1954 endif 1940 1955 endif … … 1942 1957 1943 1958 if(i.gt.1)then 1959 1944 1960 do 320 j=1,i-1 1945 1961 do il=1,ncum … … 1955 1971 enddo 1956 1972 320 continue 1973 do il=1,ncum 1974 if (cvflag_grav) then 1975 wdtrainM(il,i) = wdtrain(il)/grav-wdtrainA(il,i) ! Pm 26/08/10 RomP 1976 else 1977 wdtrainM(il,i) = wdtrain(il)/10.-wdtrainA(il,i) ! Pm 26/08/10 RomP 1978 endif 1979 enddo 1980 1957 1981 endif 1958 1982 … … 3022 3046 end 3023 3047 3048 !!RomP >>> 3024 3049 SUBROUTINE cv30_tracer(nloc,len,ncum,nd,na, 3025 & ment,sij,da,phi) 3050 & ment,sij,da,phi,phi2,d1a,dam, 3051 & ep,VPrecip,elij,clw,epmlmMm,eplaMm, 3052 & icb,inb) 3026 3053 implicit none 3054 3055 #include "cv30param.h" 3056 3027 3057 c inputs: 3028 3058 integer ncum, nd, na, nloc,len 3029 3059 real ment(nloc,na,na),sij(nloc,na,na) 3060 real clw(nloc,nd),elij(nloc,na,na) 3061 real ep(nloc,na) 3062 integer icb(nloc),inb(nloc) 3063 real VPrecip(nloc,nd+1) 3030 3064 c ouputs: 3031 3065 real da(nloc,na),phi(nloc,na,na) 3066 real phi2(nloc,na,na) 3067 real d1a(nloc,na),dam(nloc,na) 3068 real epmlmMm(nloc,na,na),eplaMm(nloc,na) 3069 ! variables pour tracer dans precip de l'AA et des mel 3032 3070 c local variables: 3033 3071 integer i,j,k 3034 c 3035 da(:,:)=0. 3036 c 3072 real epm(nloc,na,na) 3073 c 3074 ! variables d'Emanuel : du second indice au troisieme 3075 ! ---> tab(i,k,j) -> de l origine k a l arrivee j 3076 ! ment, sij, elij 3077 ! variables personnelles : du troisieme au second indice 3078 ! ---> tab(i,j,k) -> de k a j 3079 ! phi, phi2 3080 ! 3081 ! initialisations 3082 do j=1,na 3083 do i=1,ncum 3084 da(i,j)=0. 3085 d1a(i,j)=0. 3086 dam(i,j)=0. 3087 eplaMm(i,j)=0. 3088 enddo 3089 enddo 3090 do k=1,na 3091 do j=1,na 3092 do i=1,ncum 3093 epm(i,j,k)=0. 3094 epmlmMm(i,j,k)=0. 3095 phi(i,j,k)=0. 3096 phi2(i,j,k)=0. 3097 enddo 3098 enddo 3099 enddo 3100 c 3101 ! fraction deau condensee dans les melanges convertie en precip : epm 3102 ! et eau condensée précipitée dans masse d'air saturé : l_m*dM_m/dzdz.dzdz 3103 do j=1,na 3104 do k=1,j-1 3105 do i=1,ncum 3106 if(k.ge.icb(i).and.k.le.inb(i).and. 3107 & j.le.inb(i)) then 3108 epm(i,j,k)=1.-(1.-ep(i,j))*clw(i,j)/elij(i,k,j) 3109 epm(i,j,k)=max(epm(i,j,k),0.0) 3110 endif 3111 end do 3112 end do 3113 end do 3114 ! 3115 do j=1,na 3116 do k=1,na 3117 do i=1,ncum 3118 if(k.ge.icb(i).and.k.le.inb(i)) then 3119 eplaMm(i,j)=eplaMm(i,j) + ep(i,j)*clw(i,j) 3120 & *ment(i,j,k)*(1.-sij(i,j,k)) 3121 endif 3122 end do 3123 end do 3124 end do 3125 ! 3126 do j=1,na 3127 do k=1,j-1 3128 do i=1,ncum 3129 if(k.ge.icb(i).and.k.le.inb(i).and. 3130 & j.le.inb(i)) then 3131 epmlmMm(i,j,k)=epm(i,j,k)*elij(i,k,j)*ment(i,k,j) 3132 endif 3133 end do 3134 end do 3135 end do 3136 3137 ! matrices pour calculer la tendance des concentrations dans cvltr.F90 3037 3138 do j=1,na 3038 3139 do k=1,na 3039 3140 do i=1,ncum 3040 da(i,j)=da(i,j)+(1.-sij(i,k,j))*ment(i,k,j) 3041 phi(i,j,k)=sij(i,k,j)*ment(i,k,j) 3042 c print *,'da',j,k,da(i,j),sij(i,k,j),ment(i,k,j) 3141 da(i,j)=da(i,j)+(1.-sij(i,k,j))*ment(i,k,j) 3142 phi(i,j,k)=sij(i,k,j)*ment(i,k,j) 3143 d1a(i,j)=d1a(i,j)+ment(i,k,j)*ep(i,k) 3144 & *(1.-sij(i,k,j)) 3043 3145 end do 3044 3146 end do 3045 3147 end do 3046 3148 3149 do j=1,na 3150 do k=1,j-1 3151 do i=1,ncum 3152 dam(i,j)=dam(i,j)+ment(i,k,j) 3153 & *epm(i,j,k)*(1.-ep(i,k))*(1.-sij(i,k,j)) 3154 phi2(i,j,k)=phi(i,j,k)*epm(i,j,k) 3155 end do 3156 end do 3157 end do 3158 3047 3159 return 3048 3160 end 3049 3161 !RomP <<< 3050 3162 3051 3163 SUBROUTINE cv30_uncompress(nloc,len,ncum,nd,ntra,idcum 3052 3164 : ,iflag 3053 : ,precip,VPrecip, sig,w03165 : ,precip,VPrecip,evap,ep,sig,w0 3054 3166 : ,ft,fq,fu,fv,ftra 3055 3167 : ,inb 3056 3168 : ,Ma,upwd,dnwd,dnwd0,qcondc,wd,cape 3057 : ,da,phi,mp 3169 : ,da,phi,mp,phi2,d1a,dam,sij 3170 : ,elij,clw,epmlmMm,eplaMm 3171 : ,wdtrainA,wdtrainM 3058 3172 : ,iflag1 3059 : ,precip1,VPrecip1, sig1,w013173 : ,precip1,VPrecip1,evap1,ep1,sig1,w01 3060 3174 : ,ft1,fq1,fu1,fv1,ftra1 3061 3175 : ,inb1 3062 3176 : ,Ma1,upwd1,dnwd1,dnwd01,qcondc1,wd1,cape1 3063 : ,da1,phi1,mp1) 3177 : ,da1,phi1,mp1,phi21,d1a1,dam1,sij1 3178 : ,elij1,clw1,epmlmMm1,eplaMm1 3179 : ,wdtrainA1,wdtrainM1) 3064 3180 implicit none 3065 3181 … … 3072 3188 integer inb(nloc) 3073 3189 real precip(nloc) 3074 real VPrecip(nloc,nd+1) 3190 real VPrecip(nloc,nd+1),evap(nloc,nd) 3191 real ep(nloc,nd) 3075 3192 real sig(nloc,nd), w0(nloc,nd) 3076 3193 real ft(nloc,nd), fq(nloc,nd), fu(nloc,nd), fv(nloc,nd) … … 3081 3198 real wd(nloc),cape(nloc) 3082 3199 real da(nloc,nd),phi(nloc,nd,nd),mp(nloc,nd) 3200 !RomP >>> 3201 real phi2(nloc,nd,nd) 3202 real d1a(nloc,nd),dam(nloc,nd) 3203 real wdtrainA(nloc,nd), wdtrainM(nloc,nd) 3204 real sij(nloc,nd,nd) 3205 real elij(nloc,nd,nd),clw(nloc,nd) 3206 real epmlmMm(nloc,nd,nd),eplaMm(nloc,nd) 3207 !RomP <<< 3083 3208 3084 3209 c outputs: … … 3086 3211 integer inb1(len) 3087 3212 real precip1(len) 3088 real VPrecip1(len,nd+1) 3213 real VPrecip1(len,nd+1),evap1(len,nd) !<<< RomP 3214 real ep1(len,nd) !<<< RomP 3089 3215 real sig1(len,nd), w01(len,nd) 3090 3216 real ft1(len,nd), fq1(len,nd), fu1(len,nd), fv1(len,nd) … … 3095 3221 real wd1(nloc),cape1(nloc) 3096 3222 real da1(nloc,nd),phi1(nloc,nd,nd),mp1(nloc,nd) 3223 !RomP >>> 3224 real phi21(len,nd,nd) 3225 real d1a1(len,nd),dam1(len,nd) 3226 real wdtrainA1(len,nd), wdtrainM1(len,nd) 3227 real sij1(len,nd,nd) 3228 real elij1(len,nd,nd),clw1(len,nd) 3229 real epmlmMm1(len,nd,nd),eplaMm1(len,nd) 3230 !RomP <<< 3097 3231 3098 3232 c local variables: … … 3110 3244 do 2010 i=1,ncum 3111 3245 VPrecip1(idcum(i),k)=VPrecip(i,k) 3246 evap1(idcum(i),k)=evap(i,k) !<<< RomP 3112 3247 sig1(idcum(i),k)=sig(i,k) 3113 3248 w01(idcum(i),k)=w0(i,k) … … 3123 3258 da1(idcum(i),k)=da(i,k) 3124 3259 mp1(idcum(i),k)=mp(i,k) 3260 !RomP >>> 3261 ep1(idcum(i),k)=ep(i,k) 3262 d1a1(idcum(i),k)=d1a(i,k) 3263 dam1(idcum(i),k)=dam(i,k) 3264 clw1(idcum(i),k)=clw(i,k) 3265 eplaMm1(idcum(i),k)=eplaMm(i,k) 3266 wdtrainA1(idcum(i),k)=wdtrainA(i,k) 3267 wdtrainM1(idcum(i),k)=wdtrainM(i,k) 3268 !RomP <<< 3125 3269 2010 continue 3126 3270 2020 continue … … 3141 3285 do k=1,nd 3142 3286 do i=1,ncum 3287 sij1(idcum(i),k,j)=sij(i,k,j) 3143 3288 phi1(idcum(i),k,j)=phi(i,k,j) 3289 phi21(idcum(i),k,j)=phi2(i,k,j) 3290 elij1(idcum(i),k,j)=elij(i,k,j) 3291 epmlmMm1(idcum(i),k,j)=epmlmMm(i,k,j) 3144 3292 end do 3145 3293 end do
Note: See TracChangeset
for help on using the changeset viewer.