Changeset 1150 for LMDZ4/branches/LMDZ4-dev/libf/phylmd/physiq.F
- Timestamp:
- Apr 17, 2009, 5:34:01 PM (16 years ago)
- File:
-
- 1 edited
-
LMDZ4/branches/LMDZ4-dev/libf/phylmd/physiq.F (modified) (20 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/branches/LMDZ4-dev/libf/phylmd/physiq.F
r1134 r1150 50 50 c 51 51 c nlon----input-I-nombre de points horizontaux 52 c nlev----input-I-nombre de couches verticales 52 c nlev----input-I-nombre de couches verticales, doit etre egale a klev 53 53 c debut---input-L-variable logique indiquant le premier passage 54 54 c lafin---input-L-variable logique indiquant le dernier passage … … 736 736 EXTERNAL phyetat0 ! lire l'etat initial de la physique 737 737 EXTERNAL phyredem ! ecrire l'etat de redemarrage de la physique 738 EXTERNAL radlwsw ! rayonnements solaire et infrarouge739 738 EXTERNAL suphel ! initialiser certaines constantes 740 739 EXTERNAL transp ! transport total de l'eau et de l'energie … … 1056 1055 CHARACTER*40 t2mincels, t2maxcels !t2m min., t2m max 1057 1056 CHARACTER*40 tinst, tave, typeval 1058 cjq Aerosol effects (Johannes Quaas, 27/11/2003)1059 REAL sulfate(klon, klev) ! SO4 aerosol concentration [ug/m3]1060 1061 1057 REAL cldtaupi(klon,klev) ! Cloud optical thickness for pre-industrial (pi) aerosols 1062 1058 … … 1067 1063 1068 1064 ! Aerosol optical properties 1069 1070 ! Aerosol optical properties by INCA model 1071 CHARACTER*4 :: rfname(9) 1072 REAL aerindex(klon) ! POLDER aerosol index 1073 1065 CHARACTER*4, DIMENSION(9) :: rfname 1066 REAL, DIMENSION(klon) :: aerindex ! POLDER aerosol index 1067 REAL, DIMENSION(klon,klev) :: maerosol ! aerosol concentration [ug/m3] 1068 REAL, DIMENSION(klon,klev) :: maerosol_pi ! aerosol concentration [ug/m3] (pre-industrial value) 1069 REAL, DIMENSION(klon,klev,9,2) :: tau_aero, piz_aero, cg_aero 1070 REAL, DIMENSION(klon) :: topswad_aero, solswad_aero ! diag 1071 REAL, DIMENSION(klon) :: topswai_aero, solswai_aero ! diag 1072 REAL, DIMENSION(klon) :: topswad0_aero, solswad0_aero ! pas utilise, eventuellment pour diag 1073 REAL, DIMENSION(klon,9) :: topsw_aero, solsw_aero ! pas utilise 1074 REAL, DIMENSION(klon,9) :: topsw0_aero, solsw0_aero ! pas utilise 1075 1076 1074 1077 ! Parameters 1075 1078 LOGICAL ok_ade, ok_aie ! Apply aerosol (in)direct effects or not … … 1080 1083 ! false : lecture des aerosol dans un fichier 1081 1084 c$OMP THREADPRIVATE(aerosol_couple) 1082 1085 INTEGER, SAVE :: flag_aerosol 1086 c$OMP THREADPRIVATE(flag_aerosol) 1087 LOGICAL, SAVE :: new_aod 1088 c$OMP THREADPRIVATE(new_aod) 1089 1083 1090 c 1084 1091 c Declaration des constantes et des fonctions thermodynamiques … … 1106 1113 write(lunout,*) 'DEBUT DE PHYSIQ !!!!!!!!!!!!!!!!!!!!' 1107 1114 write(lunout,*) 1108 s 'nlon, nlev,nqtot,debut,lafin,rjourvrai,gmtime,pdtphys'1115 s 'nlon,klev,nqtot,debut,lafin,rjourvrai,gmtime,pdtphys' 1109 1116 write(lunout,*) 1110 s nlon, nlev,nqtot,debut,lafin,rjourvrai,gmtime,pdtphys1117 s nlon,klev,nqtot,debut,lafin,rjourvrai,gmtime,pdtphys 1111 1118 1112 1119 write(lunout,*) 'papers, play, phi, u, v, t, omega' 1113 do k=1, nlev1120 do k=1,klev 1114 1121 write(lunout,*) paprs(igout,k),pplay(igout,k),pphi(igout,k), 1115 1122 s u(igout,k),v(igout,k),t(igout,k),omega(igout,k) 1116 1123 enddo 1117 1124 write(lunout,*) 'ovap (g/kg), oliq (g/kg)' 1118 do k=1, nlev1125 do k=1,klev 1119 1126 write(lunout,*) qx(igout,k,1)*1000,qx(igout,k,2)*1000. 1120 1127 enddo … … 1190 1197 u10m(:,:)=0. 1191 1198 v10m(:,:)=0. 1192 piz_ae(:,:,:)=0.1193 tau_ae(:,:,:)=0.1194 cg_ae(:,:,:)=0.1195 1199 rain_con(:)=0. 1196 1200 snow_con(:)=0. … … 1205 1209 wmax_th(:)=0. 1206 1210 tau_overturning_th(:)=0. 1207 IF (config_inca /= 'none') THEN 1208 tau_inca(:,:,:,:) = 0. 1209 piz_inca(:,:,:,:) = 0. 1210 cg_inca(:,:,:,:) = 0. 1211 ccm(:,:,:) = 0. 1212 topswai_inca(:) = 0. 1213 topswad_inca(:) = 0. 1214 topswad0_inca(:) = 0. 1215 topsw_inca(:,:) = 0. 1216 topsw0_inca(:,:) = 0. 1217 solswai_inca(:) = 0. 1218 solswad_inca(:) = 0. 1219 solswad0_inca(:) = 0. 1220 solsw_inca(:,:) = 0. 1221 solsw0_inca(:,:) = 0. 1222 END IF 1211 1212 IF (config_inca /= 'none') ccm(:,:,:) = 0. 1223 1213 1224 1214 rnebcon0(:,:) = 0.0 … … 1239 1229 . iflag_cldcon,iflag_ratqs,ratqsbas,ratqshaut, 1240 1230 . ok_ade, ok_aie, aerosol_couple, 1231 . flag_aerosol, new_aod, 1241 1232 . bl95_b0, bl95_b1, 1242 1233 . iflag_thermals,nsplit_thermals,tau_thermals, … … 2658 2649 cjq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr) 2659 2650 IF (ok_ade.OR.ok_aie) THEN 2660 IF ( .NOT. aerosol_couple ) THEN 2661 ! Get sulfate aerosol distribution 2662 CALL readsulfate(rjourvrai, debut, sulfate) 2663 CALL readsulfate_preind(rjourvrai, debut, sulfate_pi) 2664 2665 ! Calculate aerosol optical properties (Olivier Boucher) 2666 CALL aeropt(pplay, paprs, t_seri, sulfate, rhcl, 2667 . tau_ae, piz_ae, cg_ae, aerindex) 2668 ENDIF 2651 IF (.NOT. aerosol_couple) 2652 & CALL aerosol_optic( 2653 & debut, new_aod, flag_aerosol, rjourvrai, pdtphys, 2654 & pplay, paprs, t_seri, rhcl, 2655 & maerosol, maerosol_pi, 2656 & tau_aero, piz_aero, cg_aero ) 2669 2657 ELSE 2670 tau_ae(:,:,:)=0.02671 piz_ae(:,:,:)=0.0 2672 cg_ae(:,:,:)=0.0 2658 tau_aero(:,:,:,:) = 0. 2659 piz_aero(:,:,:,:) = 0. 2660 cg_aero(:,:,:,:) = 0. 2673 2661 ENDIF 2674 2662 … … 2847 2835 2848 2836 IF (aerosol_couple) THEN 2849 sulfate(:,:)= ccm(:,:,1)2850 sulfate_pi(:,:) = ccm(:,:,2)2851 END IF2837 maerosol(:,:) = ccm(:,:,1) 2838 maerosol_pi(:,:) = ccm(:,:,2) 2839 END IF 2852 2840 2853 2841 if (ok_newmicro) then … … 2857 2845 . flwp, fiwp, flwc, fiwc, 2858 2846 e ok_aie, 2859 e sulfate, sulfate_pi,2847 e maerosol, maerosol_pi, 2860 2848 e bl95_b0, bl95_b1, 2861 2849 s cldtaupi, re, fl) … … 2865 2853 . cldh, cldl, cldm, cldt, cldq, 2866 2854 e ok_aie, 2867 e sulfate, sulfate_pi,2855 e maerosol, maerosol_pi, 2868 2856 e bl95_b0, bl95_b1, 2869 2857 s cldtaupi, re, fl) … … 2895 2883 IF (aerosol_couple) THEN 2896 2884 #ifdef INCA 2897 CALL radlwsw_inca 2898 e (kdlon,kflev,dist, rmu0, fract, solaire, 2899 e paprs, pplay,zxtsol,albsol1, albsol2, t_seri,q_seri, 2900 e wo, 2901 e cldfra, cldemi, cldtau, 2902 s heat,heat0,cool,cool0,radsol,albpla, 2903 s topsw,toplw,solsw,sollw, 2904 s sollwdown, 2905 s topsw0,toplw0,solsw0,sollw0, 2906 s lwdn0, lwdn, lwup0, lwup, 2907 s swdn0, swdn, swup0, swup, 2908 e ok_ade, ok_aie, 2909 e tau_inca, piz_inca, cg_inca, 2910 s topswad_inca, solswad_inca, 2911 s topswad0_inca, solswad0_inca, 2912 s topsw_inca, topsw0_inca, 2913 s solsw_inca, solsw0_inca, 2914 e cldtaupi, 2915 s topswai_inca, solswai_inca) 2885 CALL radlwsw_inca 2886 e (kdlon,kflev,dist, rmu0, fract, solaire, 2887 e paprs, pplay,zxtsol,albsol1, albsol2, t_seri,q_seri, 2888 e wo, 2889 e cldfra, cldemi, cldtau, 2890 s heat,heat0,cool,cool0,radsol,albpla, 2891 s topsw,toplw,solsw,sollw, 2892 s sollwdown, 2893 s topsw0,toplw0,solsw0,sollw0, 2894 s lwdn0, lwdn, lwup0, lwup, 2895 s swdn0, swdn, swup0, swup, 2896 e ok_ade, ok_aie, 2897 e tau_aero, piz_aero, cg_aero, 2898 s topswad_aero, solswad_aero, 2899 s topswad0_aero, solswad0_aero, 2900 s topsw_aero, topsw0_aero, 2901 s solsw_aero, solsw0_aero, 2902 e cldtaupi, 2903 s topswai_aero, solswai_aero) 2904 2916 2905 #endif 2917 2906 ELSE 2918 CALL radlwsw ! nouveau rayonnement (compatible Arpege-IFS) 2919 e (dist, rmu0, fract, 2920 e paprs, pplay,zxtsol,albsol1, albsol2, t_seri,q_seri, 2921 e wo, 2922 e cldfra, cldemi, cldtau, 2923 s heat,heat0,cool,cool0,radsol,albpla, 2924 s topsw,toplw,solsw,sollw, 2925 s sollwdown, 2926 s topsw0,toplw0,solsw0,sollw0, 2927 s lwdn0, lwdn, lwup0, lwup, 2928 s swdn0, swdn, swup0, swup, 2929 e ok_ade, ok_aie, ! new for aerosol radiative effects 2930 e tau_ae, piz_ae, cg_ae, ! ="= 2931 s topswad, solswad, ! ="= 2932 e cldtaupi, ! ="= 2933 s topswai, solswai,zqsat,flwc,fiwc) ! ="= 2907 2908 CALL radlwsw_aero 2909 e (dist, rmu0, fract, solaire, 2910 e paprs, pplay,zxtsol,albsol1, albsol2, 2911 e t_seri,q_seri,wo, 2912 e cldfra, cldemi, cldtau, 2913 e ok_ade, ok_aie, 2914 e tau_aero, piz_aero, cg_aero, 2915 e cldtaupi,new_aod, 2916 s heat,heat0,cool,cool0,radsol,albpla, 2917 s topsw,toplw,solsw,sollw, 2918 s sollwdown, 2919 s topsw0,toplw0,solsw0,sollw0, 2920 s lwdn0, lwdn, lwup0, lwup, 2921 s swdn0, swdn, swup0, swup, 2922 s topswad_aero, solswad_aero, 2923 s topswai_aero, solswai_aero, 2924 o topswad0_aero, solswad0_aero, 2925 o topsw_aero, topsw0_aero, 2926 o solsw_aero, solsw0_aero) 2927 2928 2934 2929 ENDIF 2935 2930 itaprad = 0 … … 3159 3154 I lafin, 3160 3155 I nlon, 3161 I nlev,3156 I klev, 3162 3157 I dtime, 3163 3158 I u, … … 3207 3202 I aerosol_couple, 3208 3203 I flxmass_w, 3209 I tau_ inca,3210 I piz_ inca,3211 I cg_ inca,3204 I tau_aero, 3205 I piz_aero, 3206 I cg_aero, 3212 3207 I ccm, 3213 3208 I rfname, … … 3218 3213 print*,'Attention on met a 0 les thermiques pour phystoke' 3219 3214 call phystokenc ( 3220 I nlon, nlev,pdtphys,rlon,rlat,3215 I nlon,klev,pdtphys,rlon,rlat, 3221 3216 I t,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, 3222 3217 I fm_therm,entr_therm, … … 3415 3410 write(lunout,*) 'FIN DE PHYSIQ !!!!!!!!!!!!!!!!!!!!' 3416 3411 write(lunout,*) 3417 s 'nlon, nlev,nqtot,debut,lafin,rjourvrai,gmtime,pdtphys pct tlos'3412 s 'nlon,klev,nqtot,debut,lafin,rjourvrai,gmtime,pdtphys pct tlos' 3418 3413 write(lunout,*) 3419 s nlon, nlev,nqtot,debut,lafin,rjourvrai,gmtime,pdtphys,3414 s nlon,klev,nqtot,debut,lafin,rjourvrai,gmtime,pdtphys, 3420 3415 s pctsrf(igout,is_ter), pctsrf(igout,is_lic),pctsrf(igout,is_oce), 3421 3416 s pctsrf(igout,is_sic) 3422 3417 write(lunout,*) 'd_t_dyn,d_t_con,d_t_lsc,d_t_ajsb,d_t_ajs,d_t_eva' 3423 do k=1, nlev3418 do k=1,klev 3424 3419 write(lunout,*) d_t_dyn(igout,k),d_t_con(igout,k), 3425 3420 s d_t_lsc(igout,k),d_t_ajsb(igout,k),d_t_ajs(igout,k), … … 3427 3422 enddo 3428 3423 write(lunout,*) 'cool,heat' 3429 do k=1, nlev3424 do k=1,klev 3430 3425 write(lunout,*) cool(igout,k),heat(igout,k) 3431 3426 enddo 3432 3427 3433 3428 write(lunout,*) 'd_t_oli,d_t_vdf,d_t_oro,d_t_lif,d_t_ec' 3434 do k=1, nlev3429 do k=1,klev 3435 3430 write(lunout,*) d_t_oli(igout,k),d_t_vdf(igout,k), 3436 3431 s d_t_oro(igout,k),d_t_lif(igout,k),d_t_ec(igout,k) … … 3439 3434 write(lunout,*) 'd_ps ',d_ps(igout) 3440 3435 write(lunout,*) 'd_u, d_v, d_t, d_qx1, d_qx2 ' 3441 do k=1, nlev3436 do k=1,klev 3442 3437 write(lunout,*) d_u(igout,k),d_v(igout,k),d_t(igout,k), 3443 3438 s d_qx(igout,k,1),d_qx(igout,k,2)
Note: See TracChangeset
for help on using the changeset viewer.
