Changeset 517
- Timestamp:
- Apr 16, 2004, 5:43:38 PM (21 years ago)
- Location:
- LMDZ.3.3/branches/rel-LF/libf/phylmd
- Files:
-
- 8 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ.3.3/branches/rel-LF/libf/phylmd/conf_phys.F90
r498 r517 5 5 subroutine conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, ok_instan, & 6 6 & fact_cldcon, facttemps,ok_newmicro,iflag_cldcon, & 7 & ratqsbas,ratqshaut,if_ebil) 7 & ratqsbas,ratqshaut,if_ebil, & 8 & ok_ade, ok_aie, & 9 & bl95_b0, bl95_b1) 8 10 9 11 use IOIPSL … … 29 31 ! ok_mensuel: sorties mensuelles 30 32 ! ok_instan: sorties instantanees 31 33 ! ok_ade, ok_aie: apply or not aerosol direct and indirect effects 34 ! bl95_b*: parameters in the formula to link CDNC to aerosol mass conc 35 ! 32 36 33 37 … … 35 39 character (len = 6) :: ocean 36 40 logical :: ok_veget, ok_newmicro 37 logical :: ok_journe, ok_mensuel, ok_instan 41 logical :: ok_journe, ok_mensuel, ok_instan 42 LOGICAL :: ok_ade, ok_aie 43 REAL :: bl95_b0, bl95_b1 38 44 real :: fact_cldcon, facttemps,ratqsbas,ratqshaut 39 45 integer :: iflag_cldcon, if_ebil … … 89 95 ok_instan = .false. 90 96 call getin('OK_instan', ok_instan) 97 ! 98 !Config Key = ok_ade 99 !Config Desc = Aerosol direct effect or not? 100 !Config Def = .false. 101 !Config Help = Used in radlwsw.F 102 ! 103 ok_ade = .false. 104 call getin('ok_ade', ok_ade) 105 106 ! 107 !Config Key = ok_aie 108 !Config Desc = Aerosol indirect effect or not? 109 !Config Def = .false. 110 !Config Help = Used in nuage.F and radlwsw.F 111 ! 112 ok_aie = .false. 113 call getin('ok_aie', ok_aie) 114 115 ! 116 !Config Key = bl95_b0 117 !Config Desc = Parameter in CDNC-maer link (Boucher&Lohmann 1995) 118 !Config Def = .false. 119 !Config Help = Used in nuage.F 120 ! 121 bl95_b0 = 2. 122 call getin('bl95_b0', bl95_b0) 123 124 !Config Key = bl95_b1 125 !Config Desc = Parameter in CDNC-maer link (Boucher&Lohmann 1995) 126 !Config Def = .false. 127 !Config Help = Used in nuage.F 128 ! 129 bl95_b1 = 0.2 130 call getin('bl95_b1', bl95_b1) 131 132 ! 91 133 ! 92 134 !Config Key = if_ebil … … 554 596 write(numout,*)' ksta_ter = ',ksta_ter 555 597 write(numout,*)' ok_kzmin = ',ok_kzmin 598 write(numout,*)' ok_ade = ',ok_ade 599 write(numout,*)' ok_aie = ',ok_aie 600 write(numout,*)' bl95_b0 = ',bl95_b0 601 write(numout,*)' bl95_b1 = ',bl95_b1 556 602 write(numout,*)' lev_histhf = ',lev_histhf 557 603 write(numout,*)' lev_histday = ',lev_histday -
LMDZ.3.3/branches/rel-LF/libf/phylmd/fisrtilp_tr.F
r230 r517 5 5 s pfrac_impa, pfrac_nucl, pfrac_1nucl, 6 6 s frac_impa, frac_nucl, 7 s prfl, psfl) 7 s prfl, psfl, 8 s RHcl) ! relative humidity in clear sky (needed for aer optical properties; aeropt.F) 8 9 9 10 c … … 37 38 REAL prfl(klon,klev+1) ! flux d'eau precipitante aux interfaces (kg/m2/s) 38 39 REAL psfl(klon,klev+1) ! flux d'eau precipitante aux interfaces (kg/m2/s) 40 41 Cjq For aerosol opt properties needed (see aeropt.F) 42 REAL RHcl(klon,klev) 43 39 44 cAA 40 45 c Coeffients de fraction lessivee : pour OFF-LINE … … 290 295 rneb(i,k) = MAX(0.0,MIN(1.0,rneb(i,k))) 291 296 zcond(i) = MAX(0.0,zqn(i)-zqs(i))*rneb(i,k)/(1.+zdqs(i)) 297 298 c--Olivier 299 RHcl(i,k)=(zqs(i)+zq(i)-zdelq)/2./zqs(i) 300 IF (rneb(i,k) .LE. 0.0) RHcl(i,k)=zq(i)/zqs(i) 301 IF (rneb(i,k) .GE. 1.0) RHcl(i,k)=1.0 302 c--fin 303 292 304 ENDDO 293 305 ELSE -
LMDZ.3.3/branches/rel-LF/libf/phylmd/ini_histmth.h
r511 r517 277 277 . "ave(X)", zsto,zout) 278 278 c 279 c Effets des aerosols 280 c 281 c IF (ok_ade.OR.ok_aie) THEN 282 CALL histdef(nid_mth, "topsad", "ADE at TOA", "W/m2", 283 . iim,jjmp1,nhori, 1,1,1, -99, 32, 284 . "ave(X)", zsto,zout) 285 c 286 CALL histdef(nid_mth, "solsad", "ADE at sfc", "W/m2", 287 . iim,jjmp1,nhori, 1,1,1, -99, 32, 288 . "ave(X)", zsto,zout) 289 c 290 CALL histdef(nid_mth, "topsai", "AIE at TOA", "W/m2", 291 . iim,jjmp1,nhori, 1,1,1, -99, 32, 292 . "ave(X)", zsto,zout) 293 c 294 CALL histdef(nid_mth, "solsai", "AIE at sfc", "W/m2", 295 . iim,jjmp1,nhori, 1,1,1, -99, 32, 296 . "ave(X)", zsto,zout) 297 c endif 298 c 299 300 c 279 301 c CALL histdef(nid_mth, "frtu", "Zonal wind stress", "Pa", 280 302 c . iim,jjmp1,nhori, 1,1,1, -99, 32, … … 693 715 . "ave(X)", zsto,zout) 694 716 ENDIF 695 C 717 c 718 c Effets des aerosols 719 c 720 c IF (ok_ade.OR.ok_aie) THEN 721 CALL histdef(nid_mth, "re", "CDR", "um", 722 . iim,jjmp1,nhori, klev,1,klev,nvert, 32, 723 . "ave(X)", zsto,zout) 724 c 725 CALL histdef(nid_mth, "redenom", "CDR denominator", "-", 726 . iim,jjmp1,nhori, klev,1,klev,nvert, 32, 727 . "ave(X)", zsto,zout) 728 c 729 CALL histdef(nid_mth, "tau", "cloud opt thickness", "-", 730 . iim,jjmp1,nhori, klev,1,klev,nvert, 32, 731 . "ave(X)", zsto,zout) 732 c 733 CALL histdef(nid_mth, "taupi", "cloud opt thickn. (pi)", "-", 734 . iim,jjmp1,nhori, klev,1,klev,nvert, 32, 735 . "ave(X)", zsto,zout) 736 c endif 737 c 738 CALL histdef(nid_mth, "ozone", "Ozone concentration", "-", 739 . iim,jjmp1,nhori, klev,1,klev,nvert, 32, 740 . "ave(X)", zsto,zout) 741 c 696 742 if (nqmax.GE.3) THEN 697 743 DO iq=1,nqmax-2 -
LMDZ.3.3/branches/rel-LF/libf/phylmd/newmicro.F
r486 r517 1 1 SUBROUTINE newmicro (paprs, pplay,ok_newmicro, 2 2 . t, pqlwp, pclc, pcltau, pclemi, 3 cIM . pch, pcl, pcm, pct, pctlwp)4 3 . pch, pcl, pcm, pct, pctlwp, 5 . xflwp, xfiwp, xflwc, xfiwc) 6 4 s xflwp, xfiwp, xflwc, xfiwc, 5 e ok_aie, 6 e sulfate, sulfate_pi, 7 e bl95_b0, bl95_b1, 8 s cldtaupi, re, fl) 7 9 IMPLICIT none 8 10 c====================================================================== … … 15 17 c pclc----input-R-couverture nuageuse pour le rayonnement (0 a 1) 16 18 c 19 c ok_aie--input-L-apply aerosol indirect effect or not 20 c sulfate-input-R-sulfate aerosol mass concentration [um/m^3] 21 c sulfate_pi-input-R-dito, pre-industrial value 22 c bl95_b0-input-R-a parameter, may be varied for tests (s-sea, l-land) 23 c bl95_b1-input-R-a parameter, may be varied for tests ( -"- ) 24 c 25 c cldtaupi-output-R-pre-industrial value of cloud optical thickness, 26 c needed for the diagnostics of the aerosol indirect 27 c radiative forcing (see radlwsw) 28 c re------output-R-Cloud droplet effective radius multiplied by fl [um] 29 c fl------output-R-Denominator to re, introduced to avoid problems in 30 c the averaging of the output. fl is the fraction of liquid 31 c water clouds within a grid cell 17 32 c pcltau--output-R-epaisseur optique des nuages 18 33 c pclemi--output-R-emissivite des nuages (0 a 1) … … 66 81 parameter (DF=1.66) ! diffusivity factor 67 82 c sb -- 68 83 cjq for the aerosol indirect effect 84 cjq introduced by Johannes Quaas (quaas@lmd.jussieu.fr), 27/11/2003 85 cjq 86 LOGICAL ok_aie ! Apply AIE or not? 87 LOGICAL ok_a1lwpdep ! a1 LWP dependent? 88 89 REAL sulfate(klon, klev) ! sulfate aerosol mass concentration [ug m-3] 90 REAL cdnc(klon, klev) ! cloud droplet number concentration [m-3] 91 REAL re(klon, klev) ! cloud droplet effective radius [um] 92 REAL sulfate_pi(klon, klev) ! sulfate aerosol mass concentration [ug m-3] (pre-industrial value) 93 REAL cdnc_pi(klon, klev) ! cloud droplet number concentration [m-3] (pi value) 94 REAL re_pi(klon, klev) ! cloud droplet effective radius [um] (pi value) 95 96 REAL fl(klon, klev) ! xliq * rneb (denominator to re; fraction of liquid water clouds within the grid cell) 97 98 REAL bl95_b0, bl95_b1 ! Parameter in B&L 95-Formula 99 100 REAL cldtaupi(klon, klev) ! pre-industrial cloud opt thickness for diag 101 cjq-end 69 102 c 70 103 c Calculer l'epaisseur optique et l'emmissivite des nuages … … 119 152 120 153 c for liquid water clouds: 154 IF (ok_aie) THEN 155 ! Formula "D" of Boucher and Lohmann, Tellus, 1995 156 ! 157 cdnc(i,k) = 10.**(bl95_b0+bl95_b1* 158 . log(MAX(sulfate(i,k),1.e-4))/log(10.))*1.e6 !-m-3 159 ! Cloud droplet number concentration (CDNC) is restricted 160 ! to be within [20, 1000 cm^3] 161 ! 162 cdnc(i,k)=MIN(1000.e6,MAX(20.e6,cdnc(i,k))) 163 ! 164 ! 165 cdnc_pi(i,k) = 10.**(bl95_b0+bl95_b1* 166 . log(MAX(sulfate_pi(i,k),1.e-4))/log(10.))*1.e6 !-m-3 167 cdnc_pi(i,k)=MIN(1000.e6,MAX(20.e6,cdnc_pi(i,k))) 168 ! 169 ! 170 ! air density: pplay(i,k) / (RD * zT(i,k)) 171 ! factor 1.1: derive effective radius from volume-mean radius 172 ! factor 1000 is the water density 173 ! _chaud means that this is the CDR for liquid water clouds 174 ! 175 rad_chaud = 176 . 1.1 * ( (pqlwp(i,k) * pplay(i,k) / (RD * T(i,k)) ) 177 . / (4./3. * RPI * 1000. * cdnc(i,k)) )**(1./3.) 178 ! 179 ! Convert to um. CDR shall be at least 3 um. 180 ! 181 c rad_chaud = MAX(rad_chaud*1.e6, 3.) 182 rad_chaud = MAX(rad_chaud*1.e6, 5.) 183 184 ! Pre-industrial cloud opt thickness 185 ! 186 ! "radius" is calculated as rad_chaud above (plus the 187 ! ice cloud contribution) but using cdnc_pi instead of 188 ! cdnc. 189 radius = 190 . 1.1 * ( (pqlwp(i,k) * pplay(i,k) / (RD * T(i,k)) ) 191 . / (4./3. * RPI * 1000. * cdnc_pi(i,k)) )**(1./3.) 192 radius = MAX(radius*1.e6, 3.) 193 194 tc = t(i,k)-273.15 195 rei = 0.71*tc + 61.29 196 if (tc.le.-81.4) rei = 3.5 197 if (zflwp(i).eq.0.) radius = 1. 198 if (zfiwp(i).eq.0. .or. rei.le.0.) rei = 1. 199 cldtaupi(i,k) = 3.0/2.0 * zflwp(i) / radius 200 . + zfiwp(i) * (3.448e-03 + 2.431/rei) 201 ENDIF ! ok_aie 202 ! For output diagnostics 203 ! 204 ! Cloud droplet effective radius [um] 205 ! 206 ! we multiply here with f * xl (fraction of liquid water 207 ! clouds in the grid cell) to avoid problems in the 208 ! averaging of the output. 209 ! In the output of IOIPSL, derive the real cloud droplet 210 ! effective radius as re/fl 211 ! 212 fl(i,k) = pclc(i,k)*(1.-zfice) 213 re(i,k) = rad_chaud*fl(i,k) 214 215 c-jq end 216 121 217 rel = rad_chaud 122 123 218 c for ice clouds: as a function of the ambiant temperature 124 219 c [formula used by Iacobellis and Somerville (2000), with an … … 156 251 IF (lo) pcltau(i,k) = 0.0 157 252 IF (lo) pclemi(i,k) = 0.0 253 254 IF (lo) cldtaupi(i,k) = 0.0 255 IF (.NOT.ok_aie) cldtaupi(i,k)=pcltau(i,k) 158 256 ENDDO 159 257 ENDDO -
LMDZ.3.3/branches/rel-LF/libf/phylmd/nuage.F
r390 r517 1 1 SUBROUTINE nuage (paprs, pplay, 2 2 . t, pqlwp, pclc, pcltau, pclemi, 3 . pch, pcl, pcm, pct, pctlwp) 3 . pch, pcl, pcm, pct, pctlwp, 4 e ok_aie, 5 e sulfate, sulfate_pi, 6 e bl95_b0, bl95_b1, 7 s cldtaupi, re, fl) 4 8 IMPLICIT none 5 9 c====================================================================== … … 11 15 c pqlwp---input-R-eau liquide nuageuse dans l'atmosphere (kg/kg) 12 16 c pclc----input-R-couverture nuageuse pour le rayonnement (0 a 1) 17 c ok_aie--input-L-apply aerosol indirect effect or not 18 c sulfate-input-R-sulfate aerosol mass concentration [um/m^3] 19 c sulfate_pi-input-R-dito, pre-industrial value 20 c bl95_b0-input-R-a parameter, may be varied for tests (s-sea, l-land) 21 c bl95_b1-input-R-a parameter, may be varied for tests ( -"- ) 22 c 23 c cldtaupi-output-R-pre-industrial value of cloud optical thickness, 24 c needed for the diagnostics of the aerosol indirect 25 c radiative forcing (see radlwsw) 26 c re------output-R-Cloud droplet effective radius multiplied by fl [um] 27 c fl------output-R-Denominator to re, introduced to avoid problems in 28 c the averaging of the output. fl is the fraction of liquid 29 c water clouds within a grid cell 13 30 c 14 31 c pcltau--output-R-epaisseur optique des nuages … … 20 37 #include "dimensions.h" 21 38 #include "dimphy.h" 22 #include "nuage.h"23 39 REAL paprs(klon,klev+1), pplay(klon,klev) 24 40 REAL t(klon,klev) … … 38 54 REAL zflwp, zradef, zfice, zmsac 39 55 c 40 REAL radius, rad_ chaud41 cccPARAMETER (rad_chau1=13.0, rad_chau2=9.0, rad_froid=35.0)56 REAL radius, rad_froid, rad_chaud, rad_chau1, rad_chau2 57 PARAMETER (rad_chau1=13.0, rad_chau2=9.0, rad_froid=35.0) 42 58 ccc PARAMETER (rad_chaud=15.0, rad_froid=35.0) 43 59 c sintex initial PARAMETER (rad_chaud=10.0, rad_froid=30.0) … … 48 64 INTEGER nexpo ! exponentiel pour glace/eau 49 65 PARAMETER (nexpo=6) 66 67 cjq for the aerosol indirect effect 68 cjq introduced by Johannes Quaas (quaas@lmd.jussieu.fr), 27/11/2003 69 cjq 70 LOGICAL ok_aie ! Apply AIE or not? 71 72 REAL sulfate(klon, klev) ! sulfate aerosol mass concentration [ug m-3] 73 REAL cdnc(klon, klev) ! cloud droplet number concentration [m-3] 74 REAL re(klon, klev) ! cloud droplet effective radius [um] 75 REAL sulfate_pi(klon, klev) ! sulfate aerosol mass concentration [ug m-3] (pre-industrial value) 76 REAL cdnc_pi(klon, klev) ! cloud droplet number concentration [m-3] (pi value) 77 REAL re_pi(klon, klev) ! cloud droplet effective radius [um] (pi value) 78 79 REAL fl(klon, klev) ! xliq * rneb (denominator to re; fraction of liquid water clouds within the grid cell) 80 81 REAL bl95_b0, bl95_b1 ! Parameter in B&L 95-Formula 82 83 REAL cldtaupi(klon, klev) ! pre-industrial cloud opt thickness for diag 84 cjq-end 85 50 86 ccc PARAMETER (nexpo=1) 51 87 c … … 56 92 rad_chaud = rad_chau1 57 93 IF (k.LE.3) rad_chaud = rad_chau2 94 58 95 pclc(i,k) = MAX(pclc(i,k), seuil_neb) 59 96 zflwp = 1000.*pqlwp(i,k)/RG/pclc(i,k) … … 62 99 zfice = MIN(MAX(zfice,0.0),1.0) 63 100 zfice = zfice**nexpo 101 102 IF (ok_aie) THEN 103 ! Formula "D" of Boucher and Lohmann, Tellus, 1995 104 ! 105 cdnc(i,k) = 10.**(bl95_b0+bl95_b1* 106 . log(MAX(sulfate(i,k),1.e-4))/log(10.))*1.e6 !-m-3 107 ! Cloud droplet number concentration (CDNC) is restricted 108 ! to be within [20, 1000 cm^3] 109 ! 110 cdnc(i,k)=MIN(1000.e6,MAX(20.e6,cdnc(i,k))) 111 cdnc_pi(i,k) = 10.**(bl95_b0+bl95_b1* 112 . log(MAX(sulfate_pi(i,k),1.e-4))/log(10.))*1.e6 !-m-3 113 cdnc_pi(i,k)=MIN(1000.e6,MAX(20.e6,cdnc_pi(i,k))) 114 ! 115 ! 116 ! air density: pplay(i,k) / (RD * zT(i,k)) 117 ! factor 1.1: derive effective radius from volume-mean radius 118 ! factor 1000 is the water density 119 ! _chaud means that this is the CDR for liquid water clouds 120 ! 121 rad_chaud = 122 . 1.1 * ( (pqlwp(i,k) * pplay(i,k) / (RD * T(i,k)) ) 123 . / (4./3. * RPI * 1000. * cdnc(i,k)) )**(1./3.) 124 ! 125 ! Convert to um. CDR shall be at least 3 um. 126 ! 127 rad_chaud = MAX(rad_chaud*1.e6, 3.) 128 129 ! For output diagnostics 130 ! 131 ! Cloud droplet effective radius [um] 132 ! 133 ! we multiply here with f * xl (fraction of liquid water 134 ! clouds in the grid cell) to avoid problems in the 135 ! averaging of the output. 136 ! In the output of IOIPSL, derive the real cloud droplet 137 ! effective radius as re/fl 138 ! 139 fl(i,k) = pclc(i,k)*(1.-zfice) 140 re(i,k) = rad_chaud*fl(i,k) 141 142 ! Pre-industrial cloud opt thickness 143 ! 144 ! "radius" is calculated as rad_chaud above (plus the 145 ! ice cloud contribution) but using cdnc_pi instead of 146 ! cdnc. 147 radius = MAX(1.1e6 * ( (pqlwp(i,k)*pplay(i,k)/(RD*T(i,k))) 148 . / (4./3.*RPI*1000.*cdnc_pi(i,k)) )**(1./3.), 149 . 3.) * (1.-zfice) + rad_froid * zfice 150 cldtaupi(i,k) = 3.0/2.0 * zflwp / radius 151 . 152 ENDIF ! ok_aie 153 64 154 radius = rad_chaud * (1.-zfice) + rad_froid * zfice 65 155 coef = coef_chau * (1.-zfice) + coef_froi * zfice … … 70 160 IF (lo) pcltau(i,k) = 0.0 71 161 IF (lo) pclemi(i,k) = 0.0 162 163 IF (.NOT.ok_aie) cldtaupi(i,k)=pcltau(i,k) 72 164 ENDDO 73 165 ENDDO -
LMDZ.3.3/branches/rel-LF/libf/phylmd/physiq.F
r515 r517 1 c 1 C 2 2 c $Header$ 3 3 c … … 143 143 LOGICAL ok_region ! sortir le fichier regional 144 144 PARAMETER (ok_region=.FALSE.) 145 c 146 c 147 LOGICAL ok_polder ! sortir échantillonné de manière POLDER 148 save ok_polder 145 149 c====================================================================== 146 150 c … … 877 881 REAL zx_lon(iim,jjmp1), zx_lat(iim,jjmp1) 878 882 c 879 INTEGER nid_day, nid_mth, nid_ins, nid_nmc 880 SAVE nid_day, nid_mth, nid_ins, nid_nmc 883 INTEGER nid_day, nid_mth, nid_ins, nid_nmc, nid_pol 884 SAVE nid_day, nid_mth, nid_ins, nid_nmc, nid_pol 881 885 c 882 886 INTEGER nhori, nvert … … 928 932 REAL zu10m(klon), zv10m(klon) !vents a 10m moyennes s/1 maille 929 933 CHARACTER*40 t2mincels, t2maxcels !t2m min., t2m max 934 cjq Aerosol effects (Johannes Quaas, 27/11/2003) 935 REAL sulfate(klon, klev) ! SO4 aerosol concentration [ug/m3] 936 REAL sulfate_pi(klon, klev) ! SO4 aerosol concentration [ug/m3] (pre-industrial value) 937 SAVE sulfate_pi 938 939 REAL cldtaupi(klon,klev) ! Cloud optical thickness for pre-industrial (pi) aerosols 940 941 REAL re(klon, klev) ! Cloud droplet effective radius 942 REAL fl(klon, klev) ! denominator of re 943 944 REAL re_top(klon), fl_top(klon) ! CDR at top of liquid water clouds 945 946 ! Aerosol optical properties 947 REAL tau_ae(klon,klev,2), piz_ae(klon,klev,2) 948 REAL cg_ae(klon,klev,2) 949 950 REAL topswad(klon), solswad(klon) ! Aerosol direct effect. 951 ! ok_ade=T -ADE=topswad-topsw 952 953 REAL topswai(klon), solswai(klon) ! Aerosol indirect effect. 954 ! ok_aie=T -> 955 ! ok_ade=T -AIE=topswai-topswad 956 ! ok_ade=F -AIE=topswai-topsw 957 958 ! For POLDER swath 959 INTEGER pyr, pmo, pday ! Year, month and day 960 INTEGER poldermask(klon) ! POLDER swath mask (0 or 1) 961 962 REAL aerindex(klon) ! POLDER aerosol index 963 964 ! Parameters 965 LOGICAL ok_ade, ok_aie ! Apply aerosol (in)direct effects or not 966 REAL bl95_b0, bl95_b1 ! Parameter in Boucher and Lohmann (1995) 967 cjq-end 930 968 c 931 969 c Declaration des constantes et des fonctions thermodynamiques … … 991 1029 call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel, 992 1030 . ok_instan, fact_cldcon, facttemps,ok_newmicro, 993 . iflag_cldcon,ratqsbas,ratqshaut, if_ebil) 1031 . iflag_cldcon,ratqsbas,ratqshaut, if_ebil, 1032 . ok_ade, ok_aie, 1033 . bl95_b0, bl95_b1) 994 1034 cIM . , RI0) 995 1035 … … 1145 1185 1146 1186 #undef histmthNMC 1147 #define histmthNMC1187 cccccccc#define histmthNMC 1148 1188 #ifdef histmthNMC 1149 1189 #include "ini_histmthNMC.h" … … 1151 1191 1152 1192 #include "ini_histins.h" 1193 #include "ini_histpol.h" 1153 1194 1154 1195 #ifdef histREGDYN … … 1912 1953 . t_seri, convliq, convfra, dtau_c, dem_c, 1913 1954 . cldh_c, cldl_c, cldm_c, cldt_c, cldq_c, 1914 . flwp_c, fiwp_c, flwc_c, fiwc_c) 1955 . flwp_c, fiwp_c, flwc_c, fiwc_c, 1956 e ok_aie, 1957 e sulfate, sulfate_pi, 1958 e bl95_b0, bl95_b1, 1959 s cldtaupi, re, fl) 1915 1960 c 1916 1961 cIM calcul tau. emi nuages startiformes … … 1918 1963 . t_seri, cldliq, cldfra, dtau_s, dem_s, 1919 1964 . cldh_s, cldl_s, cldm_s, cldt_s, cldq_s, 1920 . flwp_s, fiwp_s, flwc_s, fiwc_s) 1965 . flwp_s, fiwp_s, flwc_s, fiwc_s, 1966 e ok_aie, 1967 e sulfate, sulfate_pi, 1968 e bl95_b0, bl95_b1, 1969 s cldtaupi, re, fl) 1921 1970 c 1922 1971 cldtot(:,:)=min(max(cldfra(:,:),rnebcon(:,:)),1.) … … 2185 2234 ENDDO 2186 2235 ENDDO 2187 c 2236 cjq - introduce the aerosol direct and first indirect radiative forcings 2237 cjq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr) 2238 IF (ok_ade.OR.ok_aie) THEN 2239 ! Get sulfate aerosol distribution 2240 CALL readsulfate(rjourvrai, debut, sulfate) 2241 CALL readsulfate_preind(rjourvrai, debut, sulfate_pi) 2242 2243 ! Calculate aerosol optical properties (Olivier Boucher) 2244 CALL aeropt(pplay, paprs, t_seri, sulfate, rhcl, 2245 . tau_ae, piz_ae, cg_ae, aerindex) 2246 ENDIF 2247 2248 c 2188 2249 c Calculer les parametres optiques des nuages et quelques 2189 2250 c parametres pour diagnostiques: … … 2193 2254 . t_seri, cldliq, cldfra, cldtau, cldemi, 2194 2255 . cldh, cldl, cldm, cldt, cldq, 2195 . flwp, fiwp, flwc, fiwc) 2256 . flwp, fiwp, flwc, fiwc, 2257 e ok_aie, 2258 e sulfate, sulfate_pi, 2259 e bl95_b0, bl95_b1, 2260 s cldtaupi, re, fl) 2196 2261 else 2197 2262 CALL nuage (paprs, pplay, 2198 2263 . t_seri, cldliq, cldfra, cldtau, cldemi, 2199 . cldh, cldl, cldm, cldt, cldq) 2264 . cldh, cldl, cldm, cldt, cldq, 2265 e ok_aie, 2266 e sulfate, sulfate_pi, 2267 e bl95_b0, bl95_b1, 2268 s cldtaupi, re, fl) 2269 2200 2270 endif 2201 2271 c … … 2233 2303 s topsw0,toplw0,solsw0,sollw0, 2234 2304 s lwdn0, lwdn, lwup0, lwup, 2235 s swdn0, swdn, swup0, swup ) 2305 s swdn0, swdn, swup0, swup, 2306 e ok_ade, ok_aie, ! new for aerosol radiative effects 2307 e tau_ae, piz_ae, cg_ae, ! ="= 2308 s topswad, solswad, ! ="= 2309 e cldtaupi, ! ="= 2310 s topswai, solswai) ! ="= 2236 2311 itaprad = 0 2237 2312 ENDIF -
LMDZ.3.3/branches/rel-LF/libf/phylmd/radlwsw.F
r503 r517 1 cIM SUBROUTINE radlwsw(dist, rmu0, fract, co2_ppm, solaire,2 1 SUBROUTINE radlwsw(dist, rmu0, fract, 3 2 . paprs, pplay,tsol,albedo, alblw, t,q,wo, 4 . cldfra, cldemi, cldtau ,3 . cldfra, cldemi, cldtaupd, 5 4 . heat,heat0,cool,cool0,radsol,albpla, 6 5 . topsw,toplw,solsw,sollw, 7 6 . sollwdown, 8 cIM . sollwdown, sollwdownclr,9 cIM . toplwdown, toplwdownclr,10 7 . topsw0,toplw0,solsw0,sollw0, 11 cIM BEG12 8 . lwdn0, lwdn, lwup0, lwup, 13 cIM END 14 . swdn0, swdn, swup0, swup ) 9 . swdn0, swdn, swup0, swup, 10 . ok_ade, ok_aie, 11 . tau_ae, piz_ae, cg_ae, 12 . topswad, solswad, 13 . cldtaupi, topswai, solswai) 14 c 15 15 IMPLICIT none 16 16 c====================================================================== … … 31 31 c wo-------input-R- contenu en ozone (en cm.atm) 32 32 c cldfra---input-R- fraction nuageuse (entre 0 et 1) 33 c cldtau ---input-R- epaisseur optique des nuages dans le visible33 c cldtaupd---input-R- epaisseur optique des nuages dans le visible (present-day value) 34 34 c cldemi---input-R- emissivite des nuages dans l'IR (entre 0 et 1) 35 c ok_ade---input-L- apply the Aerosol Direct Effect or not? 36 c ok_aie---input-L- apply the Aerosol Indirect Effect or not? 37 c tau_ae, piz_ae, cg_ae-input-R- aerosol optical properties (calculated in aeropt.F) 38 c cldtaupi-input-R- epaisseur optique des nuages dans le visible 39 c calculated for pre-industrial (pi) aerosol concentrations, i.e. with smaller 40 c droplet concentration, thus larger droplets, thus generally cdltaupi cldtaupd 41 c it is needed for the diagnostics of the aerosol indirect radiative forcing 35 42 c 36 43 c heat-----output-R- echauffement atmospherique (visible) (K/jour) … … 42 49 c solsw----output-R- flux solaire net a la surface 43 50 c sollw----output-R- ray. IR montant a la surface 51 c solswad---output-R- ray. solaire net absorbe a la surface (aerosol dir) 52 c topswad---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol dir) 53 c solswai---output-R- ray. solaire net absorbe a la surface (aerosol ind) 54 c topswai---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol ind) 55 c 56 c ATTENTION: swai and swad have to be interpreted in the following manner: 57 c --------- 58 c ok_ade=F & ok_aie=F -both are zero 59 c ok_ade=T & ok_aie=F -aerosol direct forcing is F_{AD} = topsw-topswad 60 c indirect is zero 61 c ok_ade=F & ok_aie=T -aerosol indirect forcing is F_{AI} = topsw-topswai 62 c direct is zero 63 c ok_ade=T & ok_aie=T -aerosol indirect forcing is F_{AI} = topsw-topswai 64 c aerosol direct forcing is F_{AD} = topswai-topswad 65 c 66 44 67 c====================================================================== 45 68 #include "dimensions.h" … … 56 79 real albedo(klon), alblw(klon), tsol(klon) 57 80 real t(klon,klev), q(klon,klev), wo(klon,klev) 58 real cldfra(klon,klev), cldemi(klon,klev), cldtau (klon,klev)81 real cldfra(klon,klev), cldemi(klon,klev), cldtaupd(klon,klev) 59 82 real heat(klon,klev), cool(klon,klev) 60 83 real heat0(klon,klev), cool0(klon,klev) … … 123 146 REAL lwup(klon,kflev+1),lwup0(klon,kflev+1) 124 147 cIM END 125 c--------------------------------------------------------------- 148 c-OB 149 cjq the following quantities are needed for the aerosol radiative forcings 150 151 real topswad(klon), solswad(klon) ! output: aerosol direct forcing at TOA and surface 152 real topswai(klon), solswai(klon) ! output: aerosol indirect forcing atTOA and surface 153 real tau_ae(klon,klev,2), piz_ae(klon,klev,2), cg_ae(klon,klev,2) ! aerosol optical properties (see aeropt.F) 154 real cldtaupi(klon,klev) ! cloud optical thickness for pre-industrial aerosol concentrations 155 ! (i.e., with a smaller droplet concentrationand thus larger droplet radii) 156 logical ok_ade, ok_aie ! switches whether to use aerosol direct (indirect) effects or not 157 real*8 tauae(kdlon,kflev,2) ! aer opt properties 158 real*8 pizae(kdlon,kflev,2) 159 real*8 cgae(kdlon,kflev,2) 160 REAL*8 PTAUA(kdlon,2,kflev) ! present-day value of cloud opt thickness (PTAU is pre-industrial value), local use 161 REAL*8 POMEGAA(kdlon,2,kflev) ! dito for single scatt albedo 162 REAL*8 ztopswad(kdlon), zsolswad(kdlon) ! Aerosol direct forcing at TOAand surface 163 REAL*8 ztopswai(kdlon), zsolswai(kdlon) ! dito, indirect 164 cjq-end 165 166 c 167 c------------------------------------------- 126 168 nb_gr = klon / kdlon 127 169 IF (nb_gr*kdlon .NE. klon) THEN … … 202 244 PCLDLU(i,k) = cldfra(iof+i,k)*cldemi(iof+i,k) 203 245 PCLDSW(i,k) = cldfra(iof+i,k) 204 PTAU(i,1,k) = MAX(cldtau (iof+i,k), 1.0e-05)! 1e-12 serait instable205 PTAU(i,2,k) = MAX(cldtau (iof+i,k), 1.0e-05)! pour 32-bit machines246 PTAU(i,1,k) = MAX(cldtaupi(iof+i,k), 1.0e-05)! 1e-12 serait instable 247 PTAU(i,2,k) = MAX(cldtaupi(iof+i,k), 1.0e-05)! pour 32-bit machines 206 248 POMEGA(i,1,k) = 0.9999 - 5.0e-04 * EXP(-0.5 * PTAU(i,1,k)) 207 249 POMEGA(i,2,k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAU(i,2,k)) 208 250 PCG(i,1,k) = 0.865 209 251 PCG(i,2,k) = 0.910 252 c-OB 253 cjq Introduced for aerosol indirect forcings. 254 cjq The following values use the cloud optical thickness calculated from 255 cjq present-day aerosol concentrations whereas the quantities without the 256 cjq "A" at the end are for pre-industial (natural-only) aerosol concentrations 257 cjq 258 PTAUA(i,1,k) = MAX(cldtaupd(iof+i,k), 1.0e-05)! 1e-12 serait instable 259 PTAUA(i,2,k) = MAX(cldtaupd(iof+i,k), 1.0e-05)! pour 32-bit machines 260 POMEGAA(i,1,k) = 0.9999 - 5.0e-04 * EXP(-0.5 * PTAUA(i,1,k)) 261 POMEGAA(i,2,k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAUA(i,2,k)) 262 cjq-end 210 263 ENDDO 211 264 ENDDO … … 222 275 PAER(i,k,kk) = 1.0E-15 223 276 ENDDO 277 ENDDO 278 ENDDO 279 c-OB 280 DO k = 1, kflev 281 DO i = 1, kdlon 282 tauae(i,k,1)=tau_ae(iof+i,k,1) 283 pizae(i,k,1)=piz_ae(iof+i,k,1) 284 cgae(i,k,1) =cg_ae(iof+i,k,1) 285 tauae(i,k,2)=tau_ae(iof+i,k,2) 286 pizae(i,k,2)=piz_ae(iof+i,k,2) 287 cgae(i,k,2) =cg_ae(iof+i,k,2) 224 288 ENDDO 225 289 ENDDO … … 247 311 S zheat, zheat0, 248 312 S zalbpla,ztopsw,zsolsw,ztopsw0,zsolsw0, 249 S ZFSUP,ZFSDN,ZFSUP0,ZFSDN0) 313 S ZFSUP,ZFSDN,ZFSUP0,ZFSDN0, 314 S tauae, pizae, cgae, ! aerosol optical properties 315 s PTAUA, POMEGAA, 316 s ztopswad,zsolswad,ztopswai,zsolswai, ! diagnosed aerosol forcing 317 J ok_ade, ok_aie) ! apply aerosol effects or not? 318 250 319 c====================================================================== 251 320 DO i = 1, kdlon … … 292 361 c swup ( iof+i,2) = ZFSUP ( i,kflev + 1 ) 293 362 ENDDO 363 cjq-transform the aerosol forcings, if they have 364 cjq to be calculated 365 IF (ok_ade) THEN 366 DO i = 1, kdlon 367 topswad(iof+i) = ztopswad(i) 368 solswad(iof+i) = zsolswad(i) 369 ENDDO 370 ELSE 371 DO i = 1, kdlon 372 topswad(iof+i) = 0.0 373 solswad(iof+i) = 0.0 374 ENDDO 375 ENDIF 376 IF (ok_aie) THEN 377 DO i = 1, kdlon 378 topswai(iof+i) = ztopswai(i) 379 solswai(iof+i) = zsolswai(i) 380 ENDDO 381 ELSE 382 DO i = 1, kdlon 383 topswai(iof+i) = 0.0 384 solswai(iof+i) = 0.0 385 ENDDO 386 ENDIF 387 cjq-end 294 388 DO k = 1, kflev 295 389 c DO i = 1, kdlon … … 321 415 S PHEAT, PHEAT0, 322 416 S PALBPLA,PTOPSW,PSOLSW,PTOPSW0,PSOLSW0, 323 S ZFSUP,ZFSDN,ZFSUP0,ZFSDN0) 417 S ZFSUP,ZFSDN,ZFSUP0,ZFSDN0, 418 S tauae, pizae, cgae, 419 s PTAUA, POMEGAA, 420 S PTOPSWAD,PSOLSWAD,PTOPSWAI,PSOLSWAI, 421 J ok_ade, ok_aie ) 422 324 423 IMPLICIT none 325 424 … … 358 457 C ORIGINAL : 89-07-14 359 458 C 95-01-01 J.-J. MORCRETTE Direct/Diffuse Albedo 459 c 03-11-27 J. QUAAS Introduce aerosol forcings (based on BOUCHER) 360 460 C ------------------------------------------------------------------ 361 461 C … … 426 526 DATA itapsw /0/ 427 527 DATA appel1er /.TRUE./ 528 cjq-Introduced for aerosol forcings 529 real*8 flag_aer 530 logical ok_ade, ok_aie ! use aerosol forcings or not? 531 real*8 tauae(kdlon,kflev,2) ! aerosol optical properties 532 real*8 pizae(kdlon,kflev,2) ! (see aeropt.F) 533 real*8 cgae(kdlon,kflev,2) ! -"- 534 REAL*8 PTAUA(KDLON,2,KFLEV) ! CLOUD OPTICAL THICKNESS (pre-industrial value) 535 REAL*8 POMEGAA(KDLON,2,KFLEV) ! SINGLE SCATTERING ALBEDO 536 REAL*8 PTOPSWAD(KDLON) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR) 537 REAL*8 PSOLSWAD(KDLON) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR) 538 REAL*8 PTOPSWAI(KDLON) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL IND) 539 REAL*8 PSOLSWAI(KDLON) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL IND) 540 cjq - Fluxes including aerosol effects 541 REAL*8 ZFSUPAD(KDLON,KFLEV+1) 542 REAL*8 ZFSDNAD(KDLON,KFLEV+1) 543 REAL*8 ZFSUPAI(KDLON,KFLEV+1) 544 REAL*8 ZFSDNAI(KDLON,KFLEV+1) 545 SAVE ZFSUPAD, ZFSDNAD, ZFSUPAI, ZFSDNAI ! aerosol fluxes 546 cjq-end 547 428 548 c 429 549 IF (appel1er) THEN … … 451 571 INU = 1 452 572 CALL SW1S(INU, 453 S PAER, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0, 573 S PAER, flag_aer, tauae, pizae, cgae, 574 S PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0, 454 575 S ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, 455 576 S ZFD, ZFU) 456 577 INU = 2 457 578 CALL SW2S(INU, 458 S PAER, ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0, 579 S PAER, flag_aer, tauae, pizae, cgae, 580 S ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0, 459 581 S ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, 460 582 S PWV, PQS, … … 466 588 ENDDO 467 589 ENDDO 468 c cloudy-sky: 469 cIM ctes ds clesphys.h CALL SWU(PSCT,RCO2,PCLDSW,PPMB,PPSOL, 590 591 flag_aer=0.0 470 592 CALL SWU(PSCT,PCLDSW,PPMB,PPSOL, 471 593 S PRMU0,PFRAC,PTAVE,PWV, … … 473 595 INU = 1 474 596 CALL SW1S(INU, 475 S PAER, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, 597 S PAER, flag_aer, tauae, pizae, cgae, 598 S PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, 476 599 S ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, 477 600 S ZFD, ZFU) 478 601 INU = 2 479 602 CALL SW2S(INU, 480 S PAER, ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, 603 S PAER, flag_aer, tauae, pizae, cgae, 604 S ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, 481 605 S ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, 482 606 S PWV, PQS, 483 607 S ZFDOWN, ZFUP) 608 609 c cloudy-sky: 610 484 611 DO JK = 1 , KFLEV+1 485 612 DO JL = 1, KDLON … … 488 615 ENDDO 489 616 ENDDO 617 618 c 619 IF (ok_ade) THEN 490 620 c 621 c cloudy-sky + aerosol dir OB 622 flag_aer=1.0 623 CALL SWU(PSCT,PCLDSW,PPMB,PPSOL, 624 S PRMU0,PFRAC,PTAVE,PWV, 625 S ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD) 626 INU = 1 627 CALL SW1S(INU, 628 S PAER, flag_aer, tauae, pizae, cgae, 629 S PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, 630 S ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, 631 S ZFD, ZFU) 632 INU = 2 633 CALL SW2S(INU, 634 S PAER, flag_aer, tauae, pizae, cgae, 635 S ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, 636 S ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, 637 S PWV, PQS, 638 S ZFDOWN, ZFUP) 639 DO JK = 1 , KFLEV+1 640 DO JL = 1, KDLON 641 ZFSUPAD(JL,JK) = ZFSUP(JL,JK) 642 ZFSDNAD(JL,JK) = ZFSDN(JL,JK) 643 ZFSUP(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL) 644 ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL) 645 ENDDO 646 ENDDO 647 648 ENDIF ! ok_ade 649 650 IF (ok_aie) THEN 651 652 cjq cloudy-sky + aerosol direct + aerosol indirect 653 flag_aer=1.0 654 CALL SWU(PSCT,PCLDSW,PPMB,PPSOL, 655 S PRMU0,PFRAC,PTAVE,PWV, 656 S ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD) 657 INU = 1 658 CALL SW1S(INU, 659 S PAER, flag_aer, tauae, pizae, cgae, 660 S PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, 661 S ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD, 662 S ZFD, ZFU) 663 INU = 2 664 CALL SW2S(INU, 665 S PAER, flag_aer, tauae, pizae, cgae, 666 S ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, 667 S ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD, 668 S PWV, PQS, 669 S ZFDOWN, ZFUP) 670 DO JK = 1 , KFLEV+1 671 DO JL = 1, KDLON 672 ZFSUPAI(JL,JK) = ZFSUP(JL,JK) 673 ZFSDNAI(JL,JK) = ZFSDN(JL,JK) 674 ZFSUP(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL) 675 ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL) 676 ENDDO 677 ENDDO 678 ENDIF ! ok_aie 679 cjq -end 680 491 681 itapsw = 0 492 682 ENDIF … … 512 702 PSOLSW0(i) = ZFSDN0(i,1) - ZFSUP0(i,1) 513 703 PTOPSW0(i) = ZFSDN0(i,KFLEV+1) - ZFSUP0(i,KFLEV+1) 704 c-OB 705 PSOLSWAD(i) = ZFSDNAD(i,1) - ZFSUPAD(i,1) 706 PTOPSWAD(i) = ZFSDNAD(i,KFLEV+1) - ZFSUPAD(i,KFLEV+1) 707 c 708 PSOLSWAI(i) = ZFSDNAI(i,1) - ZFSUPAI(i,1) 709 PTOPSWAI(i) = ZFSDNAI(i,KFLEV+1) - ZFSUPAI(i,KFLEV+1) 710 c-fin 514 711 ENDDO 515 712 C … … 707 904 END 708 905 SUBROUTINE SW1S ( KNU 709 S , PAER , PALBD , PALBP, PCG , PCLD , PCLEAR, PCLDSW 906 S , PAER , flag_aer, tauae, pizae, cgae 907 S , PALBD , PALBP, PCG , PCLD , PCLEAR, PCLDSW 710 908 S , PDSIG , POMEGA, POZ , PRMU , PSEC , PTAU , PUD 711 909 S , PFD , PFU) … … 748 946 C 749 947 INTEGER KNU 948 c-OB 949 real*8 flag_aer 950 real*8 tauae(kdlon,kflev,2) 951 real*8 pizae(kdlon,kflev,2) 952 real*8 cgae(kdlon,kflev,2) 750 953 REAL*8 PAER(KDLON,KFLEV,5) 751 954 REAL*8 PALBD(KDLON,2) … … 839 1042 C 840 1043 CALL SWCLR ( KNU 841 S , PAER , PALBP , PDSIG , ZRAYL, PSEC 1044 S , PAER , flag_aer, tauae, pizae, cgae 1045 S , PALBP , PDSIG , ZRAYL, PSEC 842 1046 S , ZCGAZ , ZPIZAZ, ZRAY1 , ZRAY2, ZREFZ, ZRJ0 843 1047 S , ZRK0 , ZRMU0 , ZTAUAZ, ZTRA1, ZTRA2) … … 939 1143 END 940 1144 SUBROUTINE SW2S ( KNU 941 S , PAER ,PAKI, PALBD, PALBP, PCG , PCLD, PCLEAR, PCLDSW 1145 S , PAER , flag_aer, tauae, pizae, cgae 1146 S , PAKI, PALBD, PALBP, PCG , PCLD, PCLEAR, PCLDSW 942 1147 S , PDSIG ,POMEGA,POZ , PRMU , PSEC , PTAU 943 1148 S , PUD ,PWV , PQS … … 986 1191 C 987 1192 INTEGER KNU 1193 c-OB 1194 real*8 flag_aer 1195 real*8 tauae(kdlon,kflev,2) 1196 real*8 pizae(kdlon,kflev,2) 1197 real*8 cgae(kdlon,kflev,2) 988 1198 REAL*8 PAER(KDLON,KFLEV,5) 989 1199 REAL*8 PAKI(KDLON,2) … … 1107 1317 C 1108 1318 CALL SWCLR ( KNU 1109 S , PAER , PALBP , PDSIG , ZRAYL, PSEC 1319 S , PAER , flag_aer, tauae, pizae, cgae 1320 S , PALBP , PDSIG , ZRAYL, PSEC 1110 1321 S , ZCGAZ , ZPIZAZ, ZRAY1 , ZRAY2, ZREFZ, ZRJ0 1111 1322 S , ZRK0 , ZRMU0 , ZTAUAZ, ZTRA1, ZTRA2) … … 1479 1690 END 1480 1691 SUBROUTINE SWCLR ( KNU 1481 S , PAER , PALBP , PDSIG , PRAYL , PSEC 1692 S , PAER , flag_aer, tauae, pizae, cgae 1693 S , PALBP , PDSIG , PRAYL , PSEC 1482 1694 S , PCGAZ , PPIZAZ, PRAY1 , PRAY2 , PREFZ , PRJ 1483 1695 S , PRK , PRMU0 , PTAUAZ, PTRA1 , PTRA2 ) … … 1512 1724 C 1513 1725 INTEGER KNU 1726 c-OB 1727 real*8 flag_aer 1728 real*8 tauae(kdlon,kflev,2) 1729 real*8 pizae(kdlon,kflev,2) 1730 real*8 cgae(kdlon,kflev,2) 1514 1731 REAL*8 PAER(KDLON,KFLEV,5) 1515 1732 REAL*8 PALBP(KDLON,2) … … 1576 1793 C 1577 1794 DO 108 JK = 1 , KFLEV 1578 DO 104 JL = 1, KDLON 1579 PCGAZ(JL,JK) = 0. 1580 PPIZAZ(JL,JK) = 0. 1581 PTAUAZ(JL,JK) = 0. 1582 104 CONTINUE 1583 DO 106 JAE=1,5 1795 c-OB 1796 c DO 104 JL = 1, KDLON 1797 c PCGAZ(JL,JK) = 0. 1798 c PPIZAZ(JL,JK) = 0. 1799 c PTAUAZ(JL,JK) = 0. 1800 c 104 CONTINUE 1801 c-OB 1802 c DO 106 JAE=1,5 1803 c DO 105 JL = 1, KDLON 1804 c PTAUAZ(JL,JK)=PTAUAZ(JL,JK) 1805 c S +PAER(JL,JK,JAE)*TAUA(KNU,JAE) 1806 c PPIZAZ(JL,JK)=PPIZAZ(JL,JK)+PAER(JL,JK,JAE) 1807 c S * TAUA(KNU,JAE)*RPIZA(KNU,JAE) 1808 c PCGAZ(JL,JK) = PCGAZ(JL,JK) +PAER(JL,JK,JAE) 1809 c S * TAUA(KNU,JAE)*RPIZA(KNU,JAE)*RCGA(KNU,JAE) 1810 c 105 CONTINUE 1811 c 106 CONTINUE 1812 c-OB 1584 1813 DO 105 JL = 1, KDLON 1585 PTAUAZ(JL,JK)=PTAUAZ(JL,JK) 1586 S +PAER(JL,JK,JAE)*TAUA(KNU,JAE) 1587 PPIZAZ(JL,JK)=PPIZAZ(JL,JK)+PAER(JL,JK,JAE) 1588 S * TAUA(KNU,JAE)*RPIZA(KNU,JAE) 1589 PCGAZ(JL,JK) = PCGAZ(JL,JK) +PAER(JL,JK,JAE) 1590 S * TAUA(KNU,JAE)*RPIZA(KNU,JAE)*RCGA(KNU,JAE) 1814 PTAUAZ(JL,JK)=flag_aer * tauae(JL,JK,KNU) 1815 PPIZAZ(JL,JK)=flag_aer * pizae(JL,JK,KNU) 1816 PCGAZ (JL,JK)=flag_aer * cgae(JL,JK,KNU) 1591 1817 105 CONTINUE 1592 106 CONTINUE 1593 C 1818 C 1819 IF (flag_aer.GT.0) THEN 1820 c-OB 1594 1821 DO 107 JL = 1, KDLON 1595 IF (KAER.NE.0) THEN 1596 PCGAZ(JL,JK)=PCGAZ(JL,JK)/PPIZAZ(JL,JK) 1597 PPIZAZ(JL,JK)=PPIZAZ(JL,JK)/PTAUAZ(JL,JK) 1822 c PCGAZ(JL,JK)=PCGAZ(JL,JK)/PPIZAZ(JL,JK) 1823 c PPIZAZ(JL,JK)=PPIZAZ(JL,JK)/PTAUAZ(JL,JK) 1598 1824 ZTRAY = PRAYL(JL) * PDSIG(JL,JK) 1599 1825 ZRATIO = ZTRAY / (ZTRAY + PTAUAZ(JL,JK)) … … 1604 1830 PPIZAZ(JL,JK) =ZRATIO+(1.-ZRATIO)*PPIZAZ(JL,JK)*(1.-ZFF) 1605 1831 S / (1. - PPIZAZ(JL,JK) * ZFF) 1832 107 CONTINUE 1606 1833 ELSE 1834 DO JL = 1, KDLON 1607 1835 ZTRAY = PRAYL(JL) * PDSIG(JL,JK) 1608 1836 PTAUAZ(JL,JK) = ZTRAY 1609 1837 PCGAZ(JL,JK) = 0. 1610 1838 PPIZAZ(JL,JK) = 1.-REPSCT 1611 END IF 1612 107 CONTINUE 1839 END DO 1840 END IF ! check flag_aer 1841 c 107 CONTINUE 1613 1842 c PRINT 9107,JK,((PAER(JL,JK,JAE),JAE=1,5) 1614 1843 c $ ,PTAUAZ(JL,JK),PPIZAZ(JL,JK),PCGAZ(JL,JK),JL=1,KDLON) -
LMDZ.3.3/branches/rel-LF/libf/phylmd/write_histmth.h
r506 r517 262 262 $ iim*jjmp1,ndex2d) 263 263 c 264 c 265 c effets des aerosols 266 c 267 c IF (ok_ade.OR.ok_aie) THEN 268 zx_tmp_fi2d(1:klon) = topswai(1:klon) - topswad(1:klon) 269 c CALL gr_fi_ecrit(1, klon,iim,jjmp1, topswad,zx_tmp_2d) 270 CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d ,zx_tmp_2d) 271 CALL histwrite(nid_mth,"topsad",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 272 c 273 zx_tmp_fi2d(1:klon) = solswai(1:klon) - solswad(1:klon) 274 c CALL gr_fi_ecrit(1, klon,iim,jjmp1, solswad,zx_tmp_2d) 275 CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d ,zx_tmp_2d) 276 CALL histwrite(nid_mth,"solsad",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 277 c 278 zx_tmp_fi2d(1:klon) = topsw(1:klon) - topswai(1:klon) 279 c CALL gr_fi_ecrit(1, klon,iim,jjmp1, topswai,zx_tmp_2d) 280 CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d ,zx_tmp_2d) 281 CALL histwrite(nid_mth,"topsai",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 282 c 283 zx_tmp_fi2d(1:klon) = solsw(1:klon) - solswai(1:klon) 284 c CALL gr_fi_ecrit(1, klon,iim,jjmp1, solswai,zx_tmp_2d) 285 CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d ,zx_tmp_2d) 286 CALL histwrite(nid_mth,"solsai",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) 287 c endif 288 c 264 289 CALL gr_fi_ecrit(1, klon,iim,jjmp1, bils,zx_tmp_2d) 265 290 CALL histwrite(nid_mth,"bils",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) … … 712 737 ENDIF 713 738 C 739 c 740 c effets des aerosols 741 c 742 c IF (ok_ade.OR.ok_aie) THEN 743 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, re, zx_tmp_3d) 744 CALL histwrite(nid_mth,"re",itau_w,zx_tmp_3d, 745 . iim*jjmp1*klev,ndex3d) 746 c 747 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, fl, zx_tmp_3d) 748 CALL histwrite(nid_mth,"redenom",itau_w,zx_tmp_3d, 749 . iim*jjmp1*klev,ndex3d) 750 c 751 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cldtau, zx_tmp_3d) 752 CALL histwrite(nid_mth,"tau",itau_w,zx_tmp_3d, 753 . iim*jjmp1*klev,ndex3d) 754 c 755 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cldtaupi, zx_tmp_3d) 756 CALL histwrite(nid_mth,"taupi",itau_w,zx_tmp_3d, 757 . iim*jjmp1*klev,ndex3d) 758 c endif 759 c 714 760 IF (nqmax.GE.3) THEN 715 761 DO iq=1,nqmax-2
Note: See TracChangeset
for help on using the changeset viewer.