Changeset 1442
- Timestamp:
- Jun 4, 2015, 4:23:32 PM (10 years ago)
- Location:
- trunk
- Files:
-
- 15 added
- 8 deleted
- 44 edited
-
LMDZ.COMMON/libf/dyn3d/top_bound.F (modified) (1 diff)
-
LMDZ.COMMON/libf/dyn3d_common/comconst.h (deleted)
-
LMDZ.COMMON/libf/dyn3d_common/comvert.h (deleted)
-
LMDZ.COMMON/libf/dyn3d_common/disvert.F90 (modified) (2 diffs)
-
LMDZ.COMMON/libf/dyn3dpar/top_bound_p.F (modified) (1 diff)
-
LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/conf_dat3d.F (added)
-
LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/ini_archive.F (modified) (2 diffs)
-
LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/newstart.F (modified) (2 diffs)
-
LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/readstart.F (modified) (2 diffs)
-
LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/start2archive.F (modified) (2 diffs)
-
LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/startvar.F90 (modified) (4 diffs)
-
LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/write_archive.F (modified) (2 diffs)
-
LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/writerestart.F (modified) (2 diffs)
-
LMDZ.COMMON/libf/dynlonlat_phylonlat/phyvenus/conf_dat3d.F (added)
-
LMDZ.COMMON/libf/dynlonlat_phylonlat/phyvenus/ini_archive.F (modified) (2 diffs)
-
LMDZ.COMMON/libf/dynlonlat_phylonlat/phyvenus/newstart.F (modified) (10 diffs)
-
LMDZ.COMMON/libf/dynlonlat_phylonlat/phyvenus/readstart.F (modified) (2 diffs)
-
LMDZ.COMMON/libf/dynlonlat_phylonlat/phyvenus/start2archive.F (modified) (2 diffs)
-
LMDZ.COMMON/libf/dynlonlat_phylonlat/phyvenus/startvar.F90 (modified) (4 diffs)
-
LMDZ.COMMON/libf/dynlonlat_phylonlat/phyvenus/write_archive.F (modified) (2 diffs)
-
LMDZ.COMMON/libf/dynlonlat_phylonlat/phyvenus/writerestart.F (modified) (2 diffs)
-
LMDZ.TITAN/libf/phytitan/dyn1d/comconst.h (deleted)
-
LMDZ.TITAN/libf/phytitan/dyn1d/comconst_mod.F90 (added)
-
LMDZ.TITAN/libf/phytitan/dyn1d/comvert.h (deleted)
-
LMDZ.TITAN/libf/phytitan/dyn1d/comvert_mod.F90 (added)
-
LMDZ.TITAN/libf/phytitan/dyn1d/rcm1d.F (modified) (3 diffs)
-
LMDZ.VENUS/Tools/localtime.F90 (deleted)
-
LMDZ.VENUS/Tools/localtime.input (deleted)
-
LMDZ.VENUS/Tools/localtime_mean_and_std.F90 (added)
-
LMDZ.VENUS/libf/phyvenus/ballon.F (modified) (1 diff)
-
LMDZ.VENUS/libf/phyvenus/chemparam_mod.F90 (modified) (6 diffs)
-
LMDZ.VENUS/libf/phyvenus/clesphys.h (modified) (2 diffs)
-
LMDZ.VENUS/libf/phyvenus/cltrac.F (modified) (1 diff)
-
LMDZ.VENUS/libf/phyvenus/comcstVE.h (modified) (1 diff)
-
LMDZ.VENUS/libf/phyvenus/concentrations2.F (modified) (9 diffs)
-
LMDZ.VENUS/libf/phyvenus/conf_phys.F90 (modified) (4 diffs)
-
LMDZ.VENUS/libf/phyvenus/diffusion.h (added)
-
LMDZ.VENUS/libf/phyvenus/dyn1d/comconst.h (deleted)
-
LMDZ.VENUS/libf/phyvenus/dyn1d/comconst_mod.F90 (added)
-
LMDZ.VENUS/libf/phyvenus/dyn1d/comvert.h (deleted)
-
LMDZ.VENUS/libf/phyvenus/dyn1d/comvert_mod.F90 (added)
-
LMDZ.VENUS/libf/phyvenus/dyn1d/rcm1d.F (modified) (3 diffs)
-
LMDZ.VENUS/libf/phyvenus/euvheat.F90 (modified) (12 diffs)
-
LMDZ.VENUS/libf/phyvenus/hrtherm.F (modified) (2 diffs)
-
LMDZ.VENUS/libf/phyvenus/ini_histins.h (modified) (3 diffs)
-
LMDZ.VENUS/libf/phyvenus/jthermcalc.F (modified) (29 diffs)
-
LMDZ.VENUS/libf/phyvenus/moldiff_red.F90 (added)
-
LMDZ.VENUS/libf/phyvenus/moldiffcoeff_red.F (added)
-
LMDZ.VENUS/libf/phyvenus/new_cloud_sedim.F (modified) (21 diffs)
-
LMDZ.VENUS/libf/phyvenus/new_cloud_venus.F (modified) (33 diffs)
-
LMDZ.VENUS/libf/phyvenus/new_photochemistry_venus.F90 (modified) (135 diffs)
-
LMDZ.VENUS/libf/phyvenus/nirco2abs.F (modified) (14 diffs)
-
LMDZ.VENUS/libf/phyvenus/nlte_setup.F (modified) (3 diffs)
-
LMDZ.VENUS/libf/phyvenus/nlte_tcool.F (modified) (6 diffs)
-
LMDZ.VENUS/libf/phyvenus/physiq.F (modified) (23 diffs)
-
LMDZ.VENUS/libf/phyvenus/phytrac_chimie.F (modified) (11 diffs)
-
LMDZ.VENUS/libf/phyvenus/printflag.F (modified) (1 diff)
-
LMDZ.VENUS/libf/phyvenus/radlwsw.F (modified) (5 diffs)
-
LMDZ.VENUS/libf/phyvenus/sw_venus_cl.F (added)
-
LMDZ.VENUS/libf/phyvenus/sw_venus_cl_1Dglobave.F (added)
-
LMDZ.VENUS/libf/phyvenus/sw_venus_dc.F (modified) (4 diffs)
-
LMDZ.VENUS/libf/phyvenus/sw_venus_dc_1Dglobave.F (added)
-
LMDZ.VENUS/libf/phyvenus/sw_venus_ve.F (added)
-
LMDZ.VENUS/libf/phyvenus/sw_venus_ve_1Dglobave.F (added)
-
LMDZ.VENUS/libf/phyvenus/write_histins.h (modified) (5 diffs)
-
UTIL/compile (modified) (1 diff)
-
UTIL/zrecast.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.COMMON/libf/dyn3d/top_bound.F
r1422 r1442 42 42 ! NB: top_bound sponge is only called from leapfrog if ok_strato=.true. 43 43 44 ! sponge parameters: (loaded/set in conf_gcm.F ; stored in comconst .h)44 ! sponge parameters: (loaded/set in conf_gcm.F ; stored in comconst_mod) 45 45 ! iflag_top_bound=0 for no sponge 46 46 ! iflag_top_bound=1 for sponge over 4 topmost layers -
trunk/LMDZ.COMMON/libf/dyn3d_common/disvert.F90
r1422 r1442 25 25 ! Triggered by the levels number llm. 26 26 !------------------------------------------------------------------------------- 27 ! Read in "comvert .h":27 ! Read in "comvert_mod": 28 28 29 29 ! pa !--- vertical coordinate is close to a PRESSURE COORDINATE FOR P … … 31 31 32 32 ! preff !--- REFERENCE PRESSURE (101325 Pa) 33 ! Written in "comvert .h":33 ! Written in "comvert_mod": 34 34 ! ap(llm+1), bp(llm+1) !--- Ap, Bp HYBRID COEFFICIENTS AT INTERFACES 35 35 ! aps(llm), bps(llm) !--- Ap, Bp HYBRID COEFFICIENTS AT MID-LAYERS -
trunk/LMDZ.COMMON/libf/dyn3dpar/top_bound_p.F
r1422 r1442 41 41 ! NB: top_bound sponge is only called from leapfrog if ok_strato=.true. 42 42 43 ! sponge parameters: (loaded/set in conf_gcm.F ; stored in comconst .h)43 ! sponge parameters: (loaded/set in conf_gcm.F ; stored in comconst_mod) 44 44 ! iflag_top_bound=0 for no sponge 45 45 ! iflag_top_bound=1 for sponge over 4 topmost layers -
trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/ini_archive.F
r1403 r1442 27 27 28 28 USE control_mod 29 USE comconst_mod 30 USE comvert_mod, ONLY: ap,bp,presnivs,pa,preff,nivsigs,nivsig, 31 . aps,bps,scaleheight,pseudoalt, 32 . disvert_type,pressure_exner 29 33 30 34 implicit none … … 32 36 #include "dimensions.h" 33 37 #include "paramet.h" 34 #include "comconst.h"35 #include "comvert.h"36 38 #include "comgeom.h" 37 39 #include "temps.h" -
trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/newstart.F
r1403 r1442 24 24 use exner_hyb_m, only: exner_hyb 25 25 use exner_milieu_m, only: exner_milieu 26 USE comconst_mod 27 USE comvert_mod, ONLY: ap,bp,presnivs,pa,preff,nivsigs,nivsig, 28 . aps,bps,scaleheight,pseudoalt, 29 . disvert_type,pressure_exner 26 30 27 31 implicit none … … 29 33 #include "dimensions.h" 30 34 #include "paramet.h" 31 #include "comconst.h"32 35 #include "comdissnew.h" 33 #include "comvert.h"34 36 #include "comgeom2.h" 35 37 #include "logic.h" -
trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/readstart.F
r1403 r1442 6 6 7 7 USE infotrac 8 USE comconst_mod 9 USE comvert_mod, ONLY: ap,bp,presnivs,pa,preff,nivsigs,nivsig, 10 . aps,bps,scaleheight,pseudoalt, 11 . disvert_type,pressure_exner 8 12 9 13 IMPLICIT NONE … … 27 31 #include "paramet.h" 28 32 #include "temps.h" 29 #include "comconst.h"30 #include "comvert.h"31 33 #include "comgeom.h" 32 34 #include "ener.h" -
trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/start2archive.F
r1403 r1442 21 21 use exner_hyb_m, only: exner_hyb 22 22 use exner_milieu_m, only: exner_milieu 23 USE comconst_mod 24 USE comvert_mod, ONLY: ap,bp,presnivs,pa,preff,nivsigs,nivsig, 25 . aps,bps,scaleheight,pseudoalt, 26 . disvert_type,pressure_exner 23 27 24 28 implicit none … … 26 30 #include "dimensions.h" 27 31 #include "paramet.h" 28 #include "comconst.h"29 32 #include "comdissnew.h" 30 #include "comvert.h"31 33 #include "comgeom.h" 32 34 #include "logic.h" -
trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/startvar.F90
r1403 r1442 251 251 252 252 use assert_eq_m, only: assert_eq 253 253 USE comconst_mod 254 254 255 255 !------------------------------------------------------------------------------- … … 272 272 #include "iniprint.h" 273 273 #include "dimensions.h" 274 #include "comconst.h"275 274 #include "paramet.h" 276 275 #include "comgeom2.h" … … 363 362 ! 364 363 SUBROUTINE start_init_orog(iml,jml,lon_in,lat_in) 365 ! 364 USE comconst_mod 365 366 366 !------------------------------------------------------------------------------- 367 367 ! Arguments: … … 372 372 ! Local variables: 373 373 #include "iniprint.h" 374 #include "comconst.h"375 374 CHARACTER(LEN=25) :: title 376 375 CHARACTER(LEN=120) :: orofname -
trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/write_archive.F
r1403 r1442 33 33 34 34 USE control_mod 35 USE comvert_mod, ONLY: ap,bp,presnivs,pa,preff,nivsigs,nivsig, 36 . aps,bps,scaleheight,pseudoalt, 37 . disvert_type,pressure_exner 35 38 36 39 implicit none … … 38 41 #include "dimensions.h" 39 42 #include "paramet.h" 40 #include "comvert.h"41 43 #include "comgeom.h" 42 44 #include "description.h" -
trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/writerestart.F
r1403 r1442 4 4 USE IOIPSL 5 5 USE infotrac 6 USE comconst_mod 7 USE comvert_mod, ONLY: ap,bp,presnivs,pa,preff,nivsigs,nivsig, 8 . aps,bps,scaleheight,pseudoalt, 9 . disvert_type,pressure_exner 6 10 7 11 IMPLICIT NONE … … 14 18 #include "dimensions.h" 15 19 #include "paramet.h" 16 #include "comconst.h"17 #include "comvert.h"18 20 #include "comgeom.h" 19 21 #include "ener.h" -
trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phyvenus/ini_archive.F
r1403 r1442 27 27 28 28 USE control_mod 29 USE comconst_mod 30 USE comvert_mod, ONLY: ap,bp,presnivs,pa,preff,nivsigs,nivsig, 31 . aps,bps,scaleheight,pseudoalt, 32 . disvert_type,pressure_exner 29 33 30 34 implicit none … … 32 36 #include "dimensions.h" 33 37 #include "paramet.h" 34 #include "comconst.h"35 #include "comvert.h"36 38 #include "comgeom.h" 37 39 #include "temps.h" -
trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phyvenus/newstart.F
r1403 r1442 24 24 use exner_hyb_m, only: exner_hyb 25 25 use exner_milieu_m, only: exner_milieu 26 USE comconst_mod 27 USE comvert_mod, ONLY: ap,bp,presnivs,pa,preff,nivsigs,nivsig, 28 . aps,bps,scaleheight,pseudoalt, 29 . disvert_type,pressure_exner 26 30 27 31 implicit none … … 29 33 #include "dimensions.h" 30 34 #include "paramet.h" 31 #include "comconst.h"32 35 #include "comdissnew.h" 33 #include "comvert.h"34 36 #include "comgeom2.h" 35 37 #include "logic.h" … … 140 142 integer, dimension(4) :: start,counter 141 143 REAL phisinverse(iip1,jjp1) ! geopotentiel au sol avant inversion 142 logical topoflag,albedoflag,razvitu,razvitv 144 logical topoflag,notopo,albedoflag,razvitu,razvitv,uini 145 logical razTS,raztemp 146 real, dimension(:), allocatable :: tvira,dzst,zkm 143 147 real albedo 144 148 … … 880 884 topoflag = . FALSE . 881 885 CALL getin('topoflag',topoflag) 886 ! notopo = T: we go back to flat surface 887 notopo = .FALSE. 888 CALL getin('notopo',notopo) 882 889 883 890 print*,zmeaold(2,1:10) … … 906 913 . 0.0,jjm,rlonu,rlatv,.true.) 907 914 915 ELSE IF ( notopo ) THEN 916 print*,'Flattening the topography' 917 phis=0. 918 zmea=0. 919 zstd=0. 920 zsig=0. 921 zgam=0. 922 zthe=0. 923 zpic=0. 924 zval=0. 908 925 ELSE 909 926 print*,'Using existing topography' … … 950 967 951 968 c Temperature de surface 952 call interp_horiz (tsurfold,tsurfS,imold,jmold,iim,jjm,1, 953 & rlonuold,rlatvold,rlonu,rlatv) 954 call gr_dyn_fi (1,iip1,jjp1,ngridmx,tsurfS,tsurf) 955 c write(44,*) 'tsurf', tsurf 969 ! razTS need to be in the specific run.def for newstart 970 razTS = . FALSE . 971 CALL getin('razTS',razTS) 972 973 if (razTS) then 974 tsurf(:) = 735. 975 else 976 call interp_horiz (tsurfold,tsurfS,imold,jmold,iim,jjm,1, 977 & rlonuold,rlatvold,rlonu,rlatv) 978 call gr_dyn_fi (1,iip1,jjp1,ngridmx,tsurfS,tsurf) 979 c write(44,*) 'tsurf', tsurf 980 endif 956 981 957 982 c Temperature du sous-sol 958 call interp_horiz(tsoilold,tsoilS, 983 if (razTS) then 984 tsoil(:,:)=735. 985 else 986 call interp_horiz(tsoilold,tsoilS, 959 987 & imold,jmold,iim,jjm,nsoilmx, 960 988 & rlonuold,rlatvold,rlonu,rlatv) 961 call gr_dyn_fi (nsoilmx,iip1,jjp1,ngridmx,tsoilS,tsoil) 962 c write(45,*) 'tsoil',tsoil 989 call gr_dyn_fi (nsoilmx,iip1,jjp1,ngridmx,tsoilS,tsoil) 990 c write(45,*) 'tsoil',tsoil 991 endif 963 992 964 993 ! CHANGING ALBEDO: may be done through run.def … … 1050 1079 CALL pression(ip1jmp1, ap, bp, ps, p3d) 1051 1080 if (disvert_type==1) then 1052 CALL exner_hyb( ip1jmp1, ps, p3d, 1081 CALL exner_hyb( ip1jmp1, ps, p3d,pks, pk, pkf ) 1053 1082 else ! we assume that we are in the disvert_type==2 case 1054 1083 CALL exner_milieu( ip1jmp1, ps, p3d, pks, pk, pkf ) … … 1067 1096 c enddo 1068 1097 1098 ! raztemp need to be in the specific run.def for newstart 1099 raztemp = . FALSE . 1100 CALL getin('raztemp',raztemp) 1101 1102 ! Reinitialisation of temperature to VIRA profile lisse 1103 if (raztemp) then 1104 1105 allocate(tvira(0:lmold),dzst(0:lmold),zkm(0:lmold)) 1106 print*,"Venus = temperature initiale imposee = VIRA lisse " 1107 dzst(0) = 0.0 1108 dzst(1) = -log(p3d(1,1,2)/preff)*r/g 1109 do l=2,lmold 1110 dzst(l)=-log(p3d(1,1,l+1)/p3d(1,1,l))*r/g 1111 enddo 1112 tvira(0) = 735. 1113 zkm(0) = 0.0 1114 do l=1,lmold 1115 zkm(l) = zkm(l-1)+tvira(l-1)*dzst(l)/1000. ! approx avec T(l-1) 1116 if(zkm(l).lt.60.) then 1117 tvira(l)=735.-7.95*zkm(l) 1118 else 1119 tvira(l)=AMAX1(258.-3.*(zkm(l)-60.),168.) 1120 endif 1121 zkm(l) = zkm(l-1)+(tvira(l-1)+tvira(l))/2.*dzst(l)/1000. 1122 enddo 1123 do l=1,lmold 1124 do j=1,jmold+1 1125 do i=1,imold+1 1126 told(i,j,l)=tvira(l) 1127 enddo 1128 enddo 1129 enddo 1130 endif ! end raztemp 1131 1069 1132 write (*,*) 'told ', told (1,jmold+1,1) ! INFO 1070 1133 call interp_vert … … 1087 1150 teta(iip1,:,:) = teta(1,:,:) 1088 1151 1152 ! RESETING U TO uini: may be done through run.def 1153 uini = .FALSE. 1154 CALL getin('uini',uini) 1089 1155 ! RESETING U TO 0: may be done through run.def 1090 1156 razvitu = . FALSE . … … 1110 1176 call scal_wind(us,vs,unat,vnat) 1111 1177 ! Reseting u=0 1112 if (razvitu) then 1113 unat(:,:,:) = 0. 1178 if ((razvitu).and..not.(uini)) then 1179 unat(:,:,:) = 0. 1180 endif 1181 ! Reseting u=uini 1182 if ((uini).and..not.(razvitu)) then 1183 do j=1,jjp1 1184 do l=1,llm 1185 if (p3d(1,j,l).gt.3e3) then 1186 unat(:,j,l) = -110./8.03*log(p3d(:,j,l)/9.2e6) 1187 else 1188 unat(:,j,l) = 110./6.62*(log(p3d(:,j,l)/9.2e6)+14.65) 1189 endif 1190 if (abs(rlatS(1,j)).gt.50.) then 1191 unat(:,j,l)=unat(:,j,l)*(90.-abs(rlatS(:,j)))/40. 1192 endif 1193 enddo 1194 enddo 1195 endif 1196 ! incompatible options 1197 if ((uini).and.(razvitu)) then 1198 print*,"You have to choose between razvitu and uini..." 1199 stop 1114 1200 endif 1115 1201 write (*,*) 'unat ', unat (1,2,1) ! INFO 1202 1116 1203 do l=1,llm 1117 1204 do j = 1, jjp1 -
trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phyvenus/readstart.F
r1403 r1442 6 6 7 7 USE infotrac 8 USE comconst_mod 9 USE comvert_mod, ONLY: ap,bp,presnivs,pa,preff,nivsigs,nivsig, 10 . aps,bps,scaleheight,pseudoalt, 11 . disvert_type,pressure_exner 8 12 9 13 IMPLICIT NONE … … 27 31 #include "paramet.h" 28 32 #include "temps.h" 29 #include "comconst.h"30 #include "comvert.h"31 33 #include "comgeom.h" 32 34 #include "ener.h" -
trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phyvenus/start2archive.F
r1403 r1442 21 21 use exner_hyb_m, only: exner_hyb 22 22 use exner_milieu_m, only: exner_milieu 23 USE comconst_mod 24 USE comvert_mod, ONLY: ap,bp,presnivs,pa,preff,nivsigs,nivsig, 25 . aps,bps,scaleheight,pseudoalt, 26 . disvert_type,pressure_exner 23 27 24 28 implicit none … … 26 30 #include "dimensions.h" 27 31 #include "paramet.h" 28 #include "comconst.h"29 32 #include "comdissnew.h" 30 #include "comvert.h"31 33 #include "comgeom.h" 32 34 #include "logic.h" -
trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phyvenus/startvar.F90
r1403 r1442 251 251 252 252 use assert_eq_m, only: assert_eq 253 253 USE comconst_mod 254 254 255 255 !------------------------------------------------------------------------------- … … 272 272 #include "iniprint.h" 273 273 #include "dimensions.h" 274 #include "comconst.h"275 274 #include "paramet.h" 276 275 #include "comgeom2.h" … … 363 362 ! 364 363 SUBROUTINE start_init_orog(iml,jml,lon_in,lat_in) 365 ! 364 365 USE comconst_mod 366 366 367 !------------------------------------------------------------------------------- 367 368 ! Arguments: … … 372 373 ! Local variables: 373 374 #include "iniprint.h" 374 #include "comconst.h"375 375 CHARACTER(LEN=25) :: title 376 376 CHARACTER(LEN=120) :: orofname -
trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phyvenus/write_archive.F
r1403 r1442 33 33 34 34 USE control_mod 35 USE comvert_mod, ONLY: ap,bp,presnivs,pa,preff,nivsigs,nivsig, 36 . aps,bps,scaleheight,pseudoalt, 37 . disvert_type,pressure_exner 35 38 36 39 implicit none … … 38 41 #include "dimensions.h" 39 42 #include "paramet.h" 40 #include "comvert.h"41 43 #include "comgeom.h" 42 44 #include "description.h" -
trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phyvenus/writerestart.F
r1403 r1442 4 4 USE IOIPSL 5 5 USE infotrac 6 USE comconst_mod 7 USE comvert_mod, ONLY: ap,bp,presnivs,pa,preff,nivsigs,nivsig, 8 . aps,bps,scaleheight,pseudoalt, 9 . disvert_type,pressure_exner 6 10 7 11 IMPLICIT NONE … … 14 18 #include "dimensions.h" 15 19 #include "paramet.h" 16 #include "comconst.h"17 #include "comvert.h"18 20 #include "comgeom.h" 19 21 #include "ener.h" -
trunk/LMDZ.TITAN/libf/phytitan/dyn1d/rcm1d.F
r1403 r1442 7 7 use cpdet_mod, only: ini_cpdet 8 8 use moyzon_mod, only: plevmoy 9 USE comvert_mod, ONLY: ap,bp,presnivs,pa,preff,nivsigs,nivsig, 10 . aps,bps,scaleheight,pseudoalt, 11 . disvert_type,pressure_exner 9 12 IMPLICIT NONE 10 13 … … 28 31 #include "dimsoil.h" 29 32 #include "comcstfi.h" 30 #include "comvert.h"31 33 #include "netcdf.inc" 32 34 #include "logic.h" … … 75 77 character*2 str2 76 78 77 c normalement dans dyn3d/comconst .h79 c normalement dans dyn3d/comconst_mod.F90 78 80 COMMON/cpdetvenus/cppdyn,nu_venus,t0_venus 79 81 REAL cppdyn,nu_venus,t0_venus -
trunk/LMDZ.VENUS/libf/phyvenus/ballon.F
r101 r1442 167 167 phib(k)= (j-1)*20.*RPI/180. 168 168 lamb(k)= (i-3)*90.*RPI/180. ! de -180 à 90 169 lognb(k)= log10(5.e4/(RKBOL*300.)) ! ~55km in VIRA model 169 c lognb(k)= log10(5.e4/(RKBOL*300.)) ! ~55km in VIRA model 170 lognb(k)= log10(5.e5/(RKBOL*300.)) ! 5 bars (for Blamont, mai2015) 170 171 enddo 171 172 enddo -
trunk/LMDZ.VENUS/libf/phyvenus/chemparam_mod.F90
r1305 r1442 13 13 i_cocl2, i_s, i_so, i_so2, i_so3, & 14 14 i_s2o2, i_ocs, i_hso3, i_h2so4, i_s2, & 15 i_clso2, i_oscl, i_h2oliq, i_h2so4liq 15 i_clso2, i_oscl, i_h2oliq, i_h2so4liq, & 16 i_n2 16 17 17 18 REAL, DIMENSION(:), SAVE, ALLOCATABLE :: M_tr … … 19 20 20 21 !---------------------------------------------------------------------------- 21 ! number of clouds layermodelized22 ! INTEGER, PARAMETER :: nbr_cloud = 1 22 ! number of clouds mode modelized 23 INTEGER, PARAMETER :: nbr_mode = 3 23 24 INTEGER :: i_cloud 24 25 INTEGER, SAVE :: cloudmax 25 26 INTEGER, SAVE :: cloudmin 26 REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: R_MEDIAN 27 REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: STDDEV 28 REAL, SAVE :: RMI 29 REAL, SAVE :: RMA 30 REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: NBRTOT 27 REAL, SAVE, DIMENSION(:,:,:), ALLOCATABLE :: R_MEDIAN 28 REAL, SAVE, DIMENSION(:,:,:), ALLOCATABLE :: STDDEV 29 30 ! K_MASS coefficient correspondant à la partie condensee de chaque mode 31 REAL, SAVE, DIMENSION(:,:,:), ALLOCATABLE :: K_MASS 32 33 REAL, SAVE, DIMENSION(:,:,:), ALLOCATABLE :: NBRTOT 31 34 REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: WH2SO4 32 35 REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: rho_droplet … … 44 47 INTEGER :: nbr_lon,nbr_lev,i_lev 45 48 46 ALLOCATE(NBRTOT(nbr_lon,nbr_lev)) 47 ALLOCATE(R_MEDIAN(nbr_lon,nbr_lev)) 48 ALLOCATE(STDDEV(nbr_lon,nbr_lev)) 49 ALLOCATE(NBRTOT(nbr_lon,nbr_lev,nbr_mode)) 50 ALLOCATE(R_MEDIAN(nbr_lon,nbr_lev,nbr_mode)) 51 ALLOCATE(K_MASS(nbr_lon,nbr_lev,nbr_mode)) 52 ALLOCATE(STDDEV(nbr_lon,nbr_lev,nbr_mode)) 49 53 ALLOCATE(WH2SO4(nbr_lon,nbr_lev)) 50 54 ALLOCATE(rho_droplet(nbr_lon,nbr_lev)) … … 55 59 PRINT*,'nbr_lon',nbr_lon 56 60 PRINT*,'nbr_lev',nbr_lev 57 61 PRINT*,'nbr_mode',nbr_mode 62 63 NBRTOT(:,:,:) = 0.0E+0 64 WH2SO4(:,:) = 0.0E+0 65 rho_droplet(:,:) = 0.0E+0 66 58 67 !============================================================= 59 68 ! Initialisation cloud layer 1 60 69 !============================================================= 61 70 ! cloudmin et cloudmax niveaux du GCM 62 cloudmin= 1 571 cloudmin= 18 63 72 cloudmax= 50 64 ! radius min et max en microns, *e-6 dans cloud_venus -> SETBIN65 ! RMI=0.00166 ! RMA=100.067 ! NBRTOT= 0.68 73 69 74 ! radius R_MEDIAN en m (donc *e-6 pour microns) 70 75 71 R_MEDIAN(:,:)=0.0 ! Geometric Average Radius 72 STDDEV(:,:)=0.0 ! Geometric Std Deviation 76 R_MEDIAN(:,:,:)=0.0E+0 ! Geometric Average Radius 77 STDDEV(:,:,:)=0.0E+0 ! Geometric Std Deviation 78 K_MASS(:,:,:)=0.0E+0 ! Coeff multimodal 73 79 74 80 ! =============================================== … … 76 82 ! =============================================== 77 83 84 ! =============================================== 85 ! Initialisation UNIMODALE 86 ! =============================================== 87 78 88 ! Lower Haze: mode 1 79 DO i_lev=cloudmin,20 80 R_MEDIAN(:,i_lev)=0.2e-6 81 PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev) 82 STDDEV(:,i_lev)=1.56 83 PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev) 84 END DO 85 86 ! Lower Cloud: mode 2 89 ! DO i_lev=cloudmin,20 90 ! R_MEDIAN(:,i_lev,1)=0.2e-6 91 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1) 92 ! STDDEV(:,i_lev,1)=1.56 93 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1) 94 ! K_MASS(:,i_lev,1)=1.0 95 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1) 96 ! END DO 97 98 ! Lower Cloud: mode 3 87 99 ! DO i_lev=21,23 88 ! R_MEDIAN(:,i_lev)=1.4e-6 89 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev) 90 ! STDDEV(:,i_lev)=1.23 91 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev) 100 ! R_MEDIAN(:,i_lev,1)=3.65e-6 101 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1) 102 ! STDDEV(:,i_lev,1)=1.28 103 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1) 104 ! K_MASS(:,i_lev,1)=1.0 105 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1) 106 ! END DO 107 108 ! Middle Cloud: mode 2 prime 109 ! DO i_lev=24,28 110 ! R_MEDIAN(:,i_lev,1)=1.4e-6 111 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1) 112 ! STDDEV(:,i_lev,1)=1.23 113 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1) 114 ! K_MASS(:,i_lev,1)=1.0 115 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1) 116 ! END DO 117 118 ! Upper Cloud: mode 2 119 ! DO i_lev=29,35 120 ! R_MEDIAN(:,i_lev,1)=1.0e-6 121 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1) 122 ! STDDEV(:,i_lev,1)=1.29 123 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1) 124 ! K_MASS(:,i_lev,1)=1.0 125 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1) 126 ! END DO 127 128 ! Upper Haze: mode 1 129 ! DO i_lev=36, cloudmax 130 ! R_MEDIAN(:,i_lev,1)=0.2e-6 131 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1) 132 ! STDDEV(:,i_lev,1)=2.16 133 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1) 134 ! K_MASS(:,i_lev,1)=1.0 135 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1) 136 ! END DO 137 138 ! =============================================== 139 ! Initialisation TRIMODALE 140 ! =============================================== 141 142 ! Lower Haze: mode 1 143 ! DO i_lev=cloudmin,20 144 ! R_MEDIAN(:,i_lev,1)=0.3e-6 145 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1) 146 ! STDDEV(:,i_lev,1)=1.56 147 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1) 148 ! K_MASS(:,i_lev,1)=1.0 149 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1) 150 ! END DO 151 152 ! Lower Haze: mode 2 153 ! DO i_lev=cloudmin,20 154 ! R_MEDIAN(:,i_lev,2)=1.4e-6 155 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2) 156 ! STDDEV(:,i_lev,2)=1.23 157 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2) 158 ! K_MASS(:,i_lev,2)=0.0 159 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2) 160 ! END DO 161 162 ! Lower Haze: mode 3 163 ! DO i_lev=cloudmin,20 164 ! R_MEDIAN(:,i_lev,3)=3.65e-6 165 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3) 166 ! STDDEV(:,i_lev,3)=1.28 167 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3) 168 ! K_MASS(:,i_lev,3)=0. 169 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3) 170 ! END DO 171 172 ! Lower Cloud: mode 1 173 ! DO i_lev=21,23 174 ! R_MEDIAN(:,i_lev,1)=0.3e-6 175 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1) 176 ! STDDEV(:,i_lev,1)=1.56 177 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1) 178 ! K_MASS(:,i_lev,1)=0.1 179 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1) 180 ! END DO 181 182 ! Lower Cloud: mode 2 prime 183 ! DO i_lev=21,23 184 ! R_MEDIAN(:,i_lev,2)=1.4e-6 185 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2) 186 ! STDDEV(:,i_lev,2)=1.23 187 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2) 188 ! K_MASS(:,i_lev,2)=0.4 189 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2) 92 190 ! END DO 93 191 94 192 ! Lower Cloud: mode 3 95 DO i_lev=21,23 96 R_MEDIAN(:,i_lev)=3.65e-6 97 PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev) 98 STDDEV(:,i_lev)=1.28 99 PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev) 100 END DO 193 ! DO i_lev=21,23 194 ! R_MEDIAN(:,i_lev,3)=3.65e-6 195 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3) 196 ! STDDEV(:,i_lev,3)=1.28 197 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3) 198 ! K_MASS(:,i_lev,3)=0.5 199 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3) 200 ! END DO 201 202 ! Middle Cloud: mode 1 203 ! DO i_lev=24,28 204 ! R_MEDIAN(:,i_lev,1)=0.3e-6 205 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1) 206 ! STDDEV(:,i_lev,1)=1.56 207 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1) 208 ! K_MASS(:,i_lev,1)=0.0 209 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1) 210 ! END DO 101 211 102 212 ! Middle Cloud: mode 2 prime 103 DO i_lev=24,28 104 R_MEDIAN(:,i_lev)=1.4e-6 105 PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev) 106 STDDEV(:,i_lev)=1.23 107 PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev) 108 END DO 213 ! DO i_lev=24,28 214 ! R_MEDIAN(:,i_lev,2)=1.4e-6 215 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2) 216 ! STDDEV(:,i_lev,2)=1.23 217 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2) 218 ! K_MASS(:,i_lev,2)=0.8 219 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2) 220 ! END DO 109 221 110 222 ! Middle Cloud: mode 3 111 223 ! DO i_lev=24,28 112 ! R_MEDIAN(:,i_lev)=3.65e-6 113 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev) 114 ! STDDEV(:,i_lev)=1.28 115 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev) 116 ! END DO 117 118 ! Middle Cloud: mode 4 119 ! DO i_lev=24,28 120 ! R_MEDIAN(:,i_lev)=7.0e-6 121 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev) 122 ! STDDEV(:,i_lev)=1.3 123 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev) 124 ! END DO 125 126 ! Upper Cloud: mode 4 224 ! R_MEDIAN(:,i_lev,3)=3.65e-6 225 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3) 226 ! STDDEV(:,i_lev,3)=1.28 227 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3) 228 ! K_MASS(:,i_lev,3)=0.2 229 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3) 230 ! END DO 231 232 233 ! Upper Cloud: mode 1 127 234 ! DO i_lev=29,35 128 ! R_MEDIAN(:,i_lev)=7.0e-6 129 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev) 130 ! STDDEV(:,i_lev)=1.3 131 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev) 235 ! R_MEDIAN(:,i_lev,1)=0.3e-6 236 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1) 237 ! STDDEV(:,i_lev,1)=1.56 238 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1) 239 ! K_MASS(:,i_lev,1)=0.15 240 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1) 241 ! END DO 242 243 ! Upper Cloud: mode 2 244 ! DO i_lev=29,35 245 ! R_MEDIAN(:,i_lev,2)=1.0e-6 246 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2) 247 ! STDDEV(:,i_lev,2)=1.29 248 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2) 249 ! K_MASS(:,i_lev,2)=0.85 250 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2) 132 251 ! END DO 133 252 134 253 ! Upper Cloud: mode 3 135 254 ! DO i_lev=29,35 136 ! R_MEDIAN(:,i_lev)=3.65e-6 137 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev) 138 ! STDDEV(:,i_lev)=1.28 139 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev) 140 ! END DO 141 255 ! R_MEDIAN(:,i_lev,3)=3.65e-6 256 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3) 257 ! STDDEV(:,i_lev,3)=1.28 258 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3) 259 ! K_MASS(:,i_lev,3)=0.0 260 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3) 261 ! END DO 262 263 ! Upper Haze: mode 1 264 ! DO i_lev=36, cloudmax 265 ! R_MEDIAN(:,i_lev,1)=0.3e-6 266 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1) 267 ! STDDEV(:,i_lev,1)=1.56 268 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1) 269 ! K_MASS(:,i_lev,1)=1.0 270 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1) 271 ! END DO 272 273 ! Upper Haze: mode 2 274 ! DO i_lev=36, cloudmax 275 ! R_MEDIAN(:,i_lev,2)=1.e-6 276 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2) 277 ! STDDEV(:,i_lev,2)=1.29 278 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2) 279 ! K_MASS(:,i_lev,2)=0.0 280 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2) 281 ! END DO 282 283 ! Upper Haze: mode 3 284 ! DO i_lev=36, cloudmax 285 ! R_MEDIAN(:,i_lev,3)=3.65e-6 286 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3) 287 ! STDDEV(:,i_lev,3)=2.16 288 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3) 289 ! K_MASS(:,i_lev,3)=0.0 290 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3) 291 ! END DO 292 !============================================================= 293 294 ! =============================================== 295 ! Initialisation TRIMODALE Knollenberg 296 ! =============================================== 297 298 ! Lower Haze: mode 1 299 DO i_lev=cloudmin,22 300 R_MEDIAN(:,i_lev,1)=0.1e-6 301 PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1) 302 STDDEV(:,i_lev,1)=1.57 303 PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1) 304 K_MASS(:,i_lev,1)=1.0 305 PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1) 306 END DO 307 308 ! Lower Haze: mode 2 309 DO i_lev=cloudmin,22 310 R_MEDIAN(:,i_lev,2)=1.4e-6 311 PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2) 312 STDDEV(:,i_lev,2)=1.23 313 PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2) 314 K_MASS(:,i_lev,2)=0.0 315 PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2) 316 END DO 317 318 ! Lower Haze: mode 3 319 DO i_lev=cloudmin,22 320 R_MEDIAN(:,i_lev,3)=3.65e-6 321 PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3) 322 STDDEV(:,i_lev,3)=1.28 323 PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3) 324 K_MASS(:,i_lev,3)=0.0 325 PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3) 326 END DO 327 328 ! Pre Cloud: mode 1 329 DO i_lev=23,23 330 R_MEDIAN(:,i_lev,1)=0.15e-6 331 PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1) 332 STDDEV(:,i_lev,1)=1.8 333 PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1) 334 K_MASS(:,i_lev,1)=0.04 335 PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1) 336 END DO 337 338 ! Pre Cloud: mode 2 339 DO i_lev=23,23 340 R_MEDIAN(:,i_lev,2)=1.0e-6 341 PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2) 342 STDDEV(:,i_lev,2)=1.29 343 PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2) 344 K_MASS(:,i_lev,2)=0.96 345 PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2) 346 END DO 347 348 ! Pre Cloud: mode 3 349 DO i_lev=23,23 350 R_MEDIAN(:,i_lev,3)=3.65e-6 351 PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3) 352 STDDEV(:,i_lev,3)=1.28 353 PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3) 354 K_MASS(:,i_lev,3)=0.0 355 PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3) 356 END DO 357 358 ! Lower Cloud: mode 1 359 DO i_lev=24,24 360 R_MEDIAN(:,i_lev,1)=0.2e-6 361 PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1) 362 STDDEV(:,i_lev,1)=1.8 363 PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1) 364 K_MASS(:,i_lev,1)=0.014 365 PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1) 366 END DO 367 368 ! Lower Cloud: mode 2 369 DO i_lev=24,24 370 R_MEDIAN(:,i_lev,2)=1.0e-6 371 PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2) 372 STDDEV(:,i_lev,2)=1.29 373 PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2) 374 K_MASS(:,i_lev,2)=0.02 375 PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2) 376 END DO 377 378 ! Lower Cloud: mode 3 379 DO i_lev=24,24 380 R_MEDIAN(:,i_lev,3)=3.65e-6 381 PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3) 382 STDDEV(:,i_lev,3)=1.28 383 PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3) 384 K_MASS(:,i_lev,3)=0.966 385 PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3) 386 END DO 387 388 ! Middle Cloud: mode 1 389 DO i_lev=25,28 390 R_MEDIAN(:,i_lev,1)=0.15e-6 391 PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1) 392 STDDEV(:,i_lev,1)=1.9 393 PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1) 394 K_MASS(:,i_lev,1)=0.0084 395 PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1) 396 END DO 397 398 ! Middle Cloud: mode 2 prime 399 DO i_lev=25,28 400 R_MEDIAN(:,i_lev,2)=1.4e-6 401 PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2) 402 STDDEV(:,i_lev,2)=1.23 403 PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2) 404 K_MASS(:,i_lev,2)=0.21 405 PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2) 406 END DO 407 408 ! Middle Cloud: mode 3 409 DO i_lev=25,28 410 R_MEDIAN(:,i_lev,3)=3.65e-6 411 PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3) 412 STDDEV(:,i_lev,3)=1.28 413 PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3) 414 K_MASS(:,i_lev,3)=0.7816 415 PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3) 416 END DO 417 418 419 ! Upper Cloud: mode 1 420 DO i_lev=29,35 421 R_MEDIAN(:,i_lev,1)=0.2e-6 422 PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1) 423 STDDEV(:,i_lev,1)=2.16 424 PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1) 425 K_MASS(:,i_lev,1)=0.72 426 PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1) 427 END DO 428 142 429 ! Upper Cloud: mode 2 143 430 DO i_lev=29,35 144 R_MEDIAN(:,i_lev)=1.0e-6 145 PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev) 146 STDDEV(:,i_lev)=1.29 147 PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev) 431 R_MEDIAN(:,i_lev,2)=1.0e-6 432 PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2) 433 STDDEV(:,i_lev,2)=1.29 434 PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2) 435 K_MASS(:,i_lev,2)=0.28 436 PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2) 437 END DO 438 439 ! Upper Cloud: mode 3 440 DO i_lev=29,35 441 R_MEDIAN(:,i_lev,3)=3.65e-6 442 PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3) 443 STDDEV(:,i_lev,3)=1.28 444 PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3) 445 K_MASS(:,i_lev,3)=0.0 446 PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3) 148 447 END DO 149 448 150 449 ! Upper Haze: mode 1 151 450 DO i_lev=36, cloudmax 152 R_MEDIAN(:,i_lev)=0.2e-6 153 PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev) 154 STDDEV(:,i_lev)=2.16 155 PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev) 156 END DO 157 451 R_MEDIAN(:,i_lev,1)=0.2e-6 452 PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1) 453 STDDEV(:,i_lev,1)=2.16 454 PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1) 455 K_MASS(:,i_lev,1)=1.0 456 PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1) 457 END DO 458 459 ! Upper Haze: mode 2 460 DO i_lev=36, cloudmax 461 R_MEDIAN(:,i_lev,2)=1.e-6 462 PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2) 463 STDDEV(:,i_lev,2)=1.29 464 PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2) 465 K_MASS(:,i_lev,2)=0.0 466 PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2) 467 END DO 468 469 ! Upper Haze: mode 3 470 DO i_lev=36, cloudmax 471 R_MEDIAN(:,i_lev,3)=3.65e-6 472 PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3) 473 STDDEV(:,i_lev,3)=2.16 474 PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3) 475 K_MASS(:,i_lev,3)=0.0 476 PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3) 477 END DO 478 158 479 !============================================================= 159 480 481 ! =============================================================== 482 ! Initialisation TRIMODALE "Knollenberg" sans Mode3, Mode2 etendu 483 ! =============================================================== 484 485 ! Lower Haze: mode 1 486 ! DO i_lev=cloudmin,22 487 ! R_MEDIAN(:,i_lev,1)=0.1e-6 488 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1) 489 ! STDDEV(:,i_lev,1)=1.57 490 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1) 491 ! K_MASS(:,i_lev,1)=1.0 492 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1) 493 ! END DO 494 495 ! Lower Haze: mode 2 496 ! DO i_lev=cloudmin,22 497 ! R_MEDIAN(:,i_lev,2)=1.4e-6 498 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2) 499 ! STDDEV(:,i_lev,2)=1.23 500 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2) 501 ! K_MASS(:,i_lev,2)=0.0 502 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2) 503 ! END DO 504 505 ! Lower Haze: mode 3 506 ! DO i_lev=cloudmin,22 507 ! R_MEDIAN(:,i_lev,3)=3.65e-6 508 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3) 509 ! STDDEV(:,i_lev,3)=1.28 510 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3) 511 ! K_MASS(:,i_lev,3)=0.0 512 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3) 513 ! END DO 514 515 ! Pre Cloud: mode 1 516 ! DO i_lev=23,23 517 ! R_MEDIAN(:,i_lev,1)=0.15e-6 518 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1) 519 ! STDDEV(:,i_lev,1)=1.8 520 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1) 521 ! K_MASS(:,i_lev,1)=0.04 522 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1) 523 ! END DO 524 525 ! Pre Cloud: mode 2 526 ! DO i_lev=23,23 527 ! R_MEDIAN(:,i_lev,2)=1.0e-6 528 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2) 529 ! STDDEV(:,i_lev,2)=1.29 530 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2) 531 ! K_MASS(:,i_lev,2)=0.96 532 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2) 533 ! END DO 534 535 ! Pre Cloud: mode 3 536 ! DO i_lev=23,23 537 ! R_MEDIAN(:,i_lev,3)=3.65e-6 538 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3) 539 ! STDDEV(:,i_lev,3)=1.28 540 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3) 541 ! K_MASS(:,i_lev,3)=0.0 542 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3) 543 ! END DO 544 545 ! Lower Cloud: mode 1 546 ! DO i_lev=24,24 547 ! R_MEDIAN(:,i_lev,1)=0.2e-6 548 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1) 549 ! STDDEV(:,i_lev,1)=1.8 550 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1) 551 ! K_MASS(:,i_lev,1)=0.014 552 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1) 553 ! END DO 554 555 ! Lower Cloud: mode 2 556 ! DO i_lev=24,24 557 ! R_MEDIAN(:,i_lev,2)=1.0e-6 558 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2) 559 ! STDDEV(:,i_lev,2)=1.6 560 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2) 561 ! K_MASS(:,i_lev,2)=0.986 562 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2) 563 ! END DO 564 565 ! Lower Cloud: mode 3 566 ! DO i_lev=24,24 567 ! R_MEDIAN(:,i_lev,3)=3.65e-6 568 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3) 569 ! STDDEV(:,i_lev,3)=1.28 570 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3) 571 ! K_MASS(:,i_lev,3)=0. 572 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3) 573 ! END DO 574 575 ! Middle Cloud: mode 1 576 ! DO i_lev=25,28 577 ! R_MEDIAN(:,i_lev,1)=0.15e-6 578 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1) 579 ! STDDEV(:,i_lev,1)=1.9 580 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1) 581 ! K_MASS(:,i_lev,1)=0.0084 582 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1) 583 ! END DO 584 585 ! Middle Cloud: mode 2 prime 586 ! DO i_lev=25,28 587 ! R_MEDIAN(:,i_lev,2)=1.4e-6 588 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2) 589 ! STDDEV(:,i_lev,2)=1.6 590 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2) 591 ! K_MASS(:,i_lev,2)=0.9916 592 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2) 593 ! END DO 594 595 ! Middle Cloud: mode 3 596 ! DO i_lev=25,28 597 ! R_MEDIAN(:,i_lev,3)=3.65e-6 598 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3) 599 ! STDDEV(:,i_lev,3)=1.28 600 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3) 601 ! K_MASS(:,i_lev,3)=0.0 602 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3) 603 ! END DO 604 605 606 ! Upper Cloud: mode 1 607 ! DO i_lev=29,35 608 ! R_MEDIAN(:,i_lev,1)=0.2e-6 609 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1) 610 ! STDDEV(:,i_lev,1)=2.16 611 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1) 612 ! K_MASS(:,i_lev,1)=0.72 613 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1) 614 ! END DO 615 616 ! Upper Cloud: mode 2 617 ! DO i_lev=29,35 618 ! R_MEDIAN(:,i_lev,2)=1.0e-6 619 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2) 620 ! STDDEV(:,i_lev,2)=1.29 621 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2) 622 ! K_MASS(:,i_lev,2)=0.28 623 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2) 624 ! END DO 625 626 ! Upper Cloud: mode 3 627 ! DO i_lev=29,35 628 ! R_MEDIAN(:,i_lev,3)=3.65e-6 629 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3) 630 ! STDDEV(:,i_lev,3)=1.28 631 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3) 632 ! K_MASS(:,i_lev,3)=0.0 633 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3) 634 ! END DO 635 636 ! Upper Haze: mode 1 637 ! DO i_lev=36, cloudmax 638 ! R_MEDIAN(:,i_lev,1)=0.2e-6 639 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1) 640 ! STDDEV(:,i_lev,1)=2.16 641 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1) 642 ! K_MASS(:,i_lev,1)=1.0 643 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1) 644 ! END DO 645 646 ! Upper Haze: mode 2 647 ! DO i_lev=36, cloudmax 648 ! R_MEDIAN(:,i_lev,2)=1.e-6 649 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2) 650 ! STDDEV(:,i_lev,2)=1.29 651 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2) 652 ! K_MASS(:,i_lev,2)=0.0 653 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2) 654 ! END DO 655 656 ! Upper Haze: mode 3 657 ! DO i_lev=36, cloudmax 658 ! R_MEDIAN(:,i_lev,3)=3.65e-6 659 ! PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3) 660 ! STDDEV(:,i_lev,3)=2.16 661 ! PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3) 662 ! K_MASS(:,i_lev,3)=0.0 663 ! PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3) 664 ! END DO 665 !============================================================= 160 666 PRINT*,'===============================' 161 667 PRINT*,'FIN Initialisation cloud layer' 162 668 PRINT*,'===============================' 163 669 164 END SUBROUTINE 670 END SUBROUTINE cloud_ini 165 671 166 672 SUBROUTINE chemparam_ini … … 313 819 PRINT*,'h2so4liq',i_h2so4liq 314 820 M_tr(i_h2so4liq)=98.078 821 CASE('n2') 822 i_n2=i 823 M_tr(i_n2)=28.013 315 824 END SELECT 316 825 -
trunk/LMDZ.VENUS/libf/phyvenus/clesphys.h
r1310 r1442 12 12 LOGICAL ok_kzmin 13 13 LOGICAL callnlte,callnirco2,callthermos 14 LOGICAL ok_cloud, ok_chem, reinit_trac, ok_sedim 14 LOGICAL ok_cloud, ok_chem, reinit_trac, ok_sedim, ok_deltatemp 15 15 INTEGER nbapp_rad, nbapp_chim, iflag_con, iflag_ajs 16 16 INTEGER lev_histins, lev_histday, lev_histmth … … 22 22 REAL ksta, inertie 23 23 REAL euveff, solarcondate 24 INTEGER nb_mode 24 25 25 26 COMMON/clesphys_l/ cycle_diurne, soil_model, & 26 27 & ok_orodr, ok_orolf, ok_gw_nonoro, ok_kzmin, & 27 28 & callnlte,callnirco2,callthermos, & 28 & ok_cloud, ok_chem, reinit_trac, ok_sedim 29 & ok_cloud, ok_chem, reinit_trac, ok_sedim, ok_deltatemp 29 30 30 31 COMMON/clesphys_i/ nbapp_rad, nbapp_chim, & 31 32 & iflag_con, iflag_ajs, & 32 33 & lev_histins, lev_histday, lev_histmth, tr_scheme, & 33 & nircorr, nltemodel, solvarmod 34 & nircorr, nltemodel, solvarmod, nb_mode 34 35 35 36 COMMON/clesphys_r/ ecriphy, solaire, z0, lmixmin, & -
trunk/LMDZ.VENUS/libf/phyvenus/cltrac.F
r101 r1442 121 121 c ATTENTION SHUNTE!!!!!! 122 122 123 DO k = 1, klev124 DO i = 1, klon125 d_tr(i,k) = 0.126 ENDDO127 ENDDO123 c DO k = 1, klev 124 c DO i = 1, klon 125 c d_tr(i,k) = 0. 126 c ENDDO 127 c ENDDO 128 128 129 129 RETURN -
trunk/LMDZ.VENUS/libf/phyvenus/comcstVE.h
r1301 r1442 4 4 integer nnuve,nbmat 5 5 parameter (nnuve=68) ! fichiers Vincent et Bullock 6 parameter (nbmat=210) ! Max number of matrixes in Vincent's file 6 ! parameter (nnuve=598) ! fichiers Vincent et Bullock 7 parameter (nbmat=220) ! Max number of matrixes in Vincent's file 7 8 8 9 common/comcstVE/al,bl,nlatve,indexve,nbpsve,nbszave, & -
trunk/LMDZ.VENUS/libf/phyvenus/concentrations2.F
r1310 r1442 1 SUBROUTINE concentrations2(pplay,t_seri,pdt, co2vmr_gcm, n2vmr_gcm,2 $ covmr_gcm,o3pvmr_gcm,nvmr_gcm,ptimestep)1 SUBROUTINE concentrations2(pplay,t_seri,pdt,tr_seri, nqmx, 2 $ ptimestep) 3 3 4 4 use dimphy 5 5 use conc, only: mmean, Akknew, rnew, cpnew 6 6 use cpdet_mod, only: cpdet 7 USE chemparam_mod 8 use infotrac 9 7 10 implicit none 8 11 … … 26 29 c#include "chimiedata.h" 27 30 c#include "tracer.h" 28 #include "mmol.h"31 c#include "mmol.h" 29 32 30 33 ! input/output … … 32 35 real pplay(klon,klev) 33 36 c real pt(klon,klev) 37 integer,intent(in) :: nqmx ! number of tracers 34 38 real t_seri(klon, klev) 35 39 real pdt(klon,klev) 36 real co2vmr_gcm(klon,klev), n2vmr_gcm(klon,klev) 37 real covmr_gcm(klon,klev) 38 real o3pvmr_gcm(klon,klev),nvmr_gcm(klon,klev) 39 c real pq(klon,klev,nqmx) 40 real n2vmr_gcm(klon,klev),nvmr_gcm(klon,klev) 41 real tr_seri(klon,klev,nqmx) 40 42 c real pdq(klon,klev,nqmx) 41 43 real ptimestep … … 44 46 45 47 integer :: i, l, ig, iq 46 real :: ntot 48 integer, save :: nbq 49 integer,allocatable,save :: niq(:) 50 real :: ni(nqmx), ntot 47 51 real :: zt(klon, klev) 48 real , save :: akico2,akio,akin2,akico49 real, save :: akin50 real, save :: cpico2,cpico,cpio,cpin251 real, save :: cpio252 real :: zq(klon, klev, nqmx) 53 real,allocatable,save :: aki(:) 54 real,allocatable,save :: cpi(:) 55 real, save :: akin,akin2 52 56 53 57 logical, save :: firstcall = .true. … … 58 62 ! values are taken from the literature [J/kg K] 59 63 60 ! co2 61 akico2 = 3.072e-4 62 cpico2 = 0.834e3 63 64 ! co 65 akico = 4.87e-4 66 cpico = 1.034e3 67 68 ! o 69 akio = 7.59e-4 70 cpio = 1.3e3 71 72 ! n 73 ! akin = 0.0 74 ! cpin = 0.0 64 ! allocate local saved arrays: 65 allocate(aki(nqmx)) 66 allocate(cpi(nqmx)) 67 allocate(niq(nqmx)) 68 69 ! find index of chemical tracers to use 70 ! initialize thermal conductivity and specific heat coefficients 71 ! !? values are estimated 72 73 nbq = 0 ! to count number of tracers used in this subroutine 74 75 if (i_co2 /= 0) then 76 nbq = nbq + 1 77 niq(nbq) = i_co2 78 aki(nbq) = 3.072e-4 79 cpi(nbq) = 0.834e3 80 end if 81 if (i_co /= 0) then 82 nbq = nbq + 1 83 niq(nbq) = i_co 84 aki(nbq) = 4.87e-4 85 cpi(nbq) = 1.034e3 86 end if 87 if (i_o /= 0) then 88 nbq = nbq + 1 89 niq(nbq) = i_o 90 aki(nbq) = 7.59e-4 91 cpi(nbq) = 1.3e3 92 end if 93 if (i_o1d /= 0) then 94 nbq = nbq + 1 95 niq(nbq) = i_o1d 96 aki(nbq) = 7.59e-4 !? 97 cpi(nbq) = 1.3e3 !? 98 end if 99 if (i_o2 /= 0) then 100 nbq = nbq + 1 101 niq(nbq) = i_o2 102 aki(nbq) = 5.68e-4 103 cpi(nbq) = 0.9194e3 104 end if 105 if (i_o3 /= 0) then 106 nbq = nbq + 1 107 niq(nbq) = i_o3 108 aki(nbq) = 3.00e-4 !? 109 cpi(nbq) = 0.800e3 !? 110 end if 111 if (i_h /= 0) then 112 nbq = nbq + 1 113 niq(nbq) = i_h 114 aki(nbq) = 0.0 115 cpi(nbq) = 20.780e3 116 end if 117 if (i_h2 /= 0) then 118 nbq = nbq + 1 119 niq(nbq) = i_h2 120 aki(nbq) = 36.314e-4 121 cpi(nbq) = 14.266e3 122 end if 123 if (i_oh /= 0) then 124 nbq = nbq + 1 125 niq(nbq) = i_oh 126 aki(nbq) = 7.00e-4 !? 127 cpi(nbq) = 1.045e3 128 end if 129 if (i_ho2 /= 0) then 130 nbq = nbq + 1 131 niq(nbq) = i_ho2 132 aki(nbq) = 0.0 133 cpi(nbq) = 1.065e3 !? 134 end if 135 if (i_n2 /= 0) then 136 nbq = nbq + 1 137 niq(nbq) = i_n2 138 aki(nbq) = 5.6e-4 139 cpi(nbq) = 1.034e3 140 end if 141 c if (i_ar /= 0) then 142 c nbq = nbq + 1 143 c niq(nbq) = i_ar 144 c aki(nbq) = 0.0 !? 145 c cpi(nbq) = 1.000e3 !? 146 c end if 147 if (i_h2o /= 0) then 148 nbq = nbq + 1 149 niq(nbq) = i_h2o 150 aki(nbq) = 0.0 151 cpi(nbq) = 1.870e3 152 end if 153 c if (i_n /= 0) then 154 c nbq = nbq + 1 155 c niq(nbq) = i_n 156 c aki(nbq) = 0.0 157 c cpi(nbq) = 0.0 158 c endif 159 c if(i_no /= 0) then 160 c nbq = nbq + 1 161 c niq(nbq) = i_no 162 c aki(nbq) = 0.0 163 c cpi(nbq) = 0.0 164 c endif 165 c if(i_no2 /= 0) then 166 c nbq = nbq + 1 167 c niq(nbq) = i_no2 168 c aki(nbq) = 0.0 169 c cpi(nbq) = 0.0 170 c endif 171 c if(i_n2d /= 0) then 172 c nbq = nbq + 1 173 c niq(nbq) = i_n2d 174 c aki(nbq) = 0.0 175 c cpi(nbq) = 0.0 176 c endif 75 177 76 178 ! n2 77 akin2 = 5.6e-4 78 cpin2 = 1.034e3 179 c akin2 = 5.6e-4 180 c cpin2 = 1.034e3 181 182 183 184 ! tell the world about it: 185 write(*,*) "concentrations: firstcall, nbq=",nbq 186 ! write(*,*) " niq(1:nbq)=",niq(1:nbq) 187 ! write(*,*) " aki(1:nbq)=",aki(1:nbq) 188 ! write(*,*) " cpi(1:nbq)=",cpi(1:nbq) 189 79 190 80 191 firstcall = .false. … … 85 196 do l = 1,klev 86 197 do ig = 1,klon 87 c zt(ig,l) = pt(ig,l) + pdt(ig,l)*ptimestep88 198 zt(ig,l) = t_seri(ig,l) 89 90 199 end do 91 200 end do 92 201 202 203 ! update mass mixing ratio tracers 204 205 do l = 1,klev 206 do ig = 1,klon 207 do i = 1,nqmx 208 ! iq = niq(i) 209 zq(ig,l,i) = max(1.e-30, tr_seri(ig,l,i)) 210 end do 211 end do 212 end do 213 93 214 ! mmean : mean molecular mass 94 215 ! rnew : specific gas constant … … 98 219 do l = 1,klev 99 220 do ig = 1,klon 100 c do i = 1,nbq 101 c iq = niq(i) 102 c mmean(ig,l) = mmean(ig,l) + zq(ig,l,iq)/mmol(iq) 103 c end do 104 mmean(ig,l) = RMD 221 do i = 1,nqmx 222 iq = niq(i) 223 mmean(ig,l) = mmean(ig,l) + zq(ig,l,i)/M_tr(i) 224 end do 225 c mmean(ig,l) = RMD 226 mmean(ig,l) = 1./mmean(ig,l) 105 227 rnew(ig,l) = 8.314/mmean(ig,l)*1.e3 ! J/kg K 228 229 c write(*,*),'Mmean: ',ig, l, mmean(0,l) 106 230 end do 107 231 end do … … 110 234 ! akknew : thermal conductivity cofficient 111 235 112 ccpnew(:,:) = 0.113 cakknew(:,:) = 0.236 cpnew(:,:) = 0. 237 akknew(:,:) = 0. 114 238 115 239 do l = 1,klev … … 118 242 ntot = pplay(ig,l)/(RKBOL*zt(ig,l))*1.e-6 ! in #/cm3 119 243 120 cpnew(ig,l) = ntot*o3pvmr_gcm(ig,l)*cpio 121 $ +ntot* co2vmr_gcm(ig,l)*cpdet(zt(ig,l)) 122 $ + ntot*n2vmr_gcm(ig,l)*cpin2 + ntot*covmr_gcm(ig,l)*cpico 123 124 125 akknew(ig,l) = ntot*o3pvmr_gcm(ig,l)*akio + 126 $ ntot*co2vmr_gcm(ig,l)*akico2 + 127 $ ntot*n2vmr_gcm(ig,l)*akin2 + ntot*covmr_gcm(ig,l)*akico 128 244 !!! --- INSERT N2 values ---- 245 !! WARNING -> Cp here below doesn't depend on T (cpdet) 246 247 do i = 1,nbq 248 c iq = niq(i) 249 ni(i) = ntot*zq(ig,l,i)*mmean(ig,l)/M_tr(i) 250 cpnew(ig,l) = cpnew(ig,l) + ni(i)*cpi(i) 251 akknew(ig,l) = akknew(ig,l) + ni(i)*aki(i) 252 end do 253 129 254 130 255 cpnew(ig,l) = cpnew(ig,l)/ntot 131 256 akknew(ig,l)= akknew(ig,l)/ntot 132 257 133 c print*, '--- concentrations ---' 134 c print*, l, cpnew(1,l), rnew(1,l), akknew(1,l) 258 135 259 end do 136 260 end do 137 c STOP138 261 139 262 return -
trunk/LMDZ.VENUS/libf/phyvenus/conf_phys.F90
r1310 r1442 38 38 39 39 !Config Key = cycle_diurne 40 !Config Desc = Cycle d diurne40 !Config Desc = Cycle diurne 41 41 !Config Def = y 42 42 !Config Help = Cette option permet d'eteidre le cycle diurne. … … 361 361 ok_sedim = .FALSE. 362 362 call getin('ok_sedim',ok_sedim) 363 363 364 ! 365 !Config Key = ok_deltatemp 366 !Config Desc = 367 !Config Def = .FALSE. 368 !Config Help = 369 ! 370 ok_deltatemp = .FALSE. 371 call getin('ok_deltatemp',ok_deltatemp) 372 373 ! 374 !Config Key = nb_mode 375 !Config Desc = 376 !Config Def = 0 377 !Config Help = 378 ! 379 nb_mode = 0 380 call getin('nb_mode',nb_mode) 381 364 382 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 365 383 ! PARAMETER FOR NLTE PHYSICS … … 422 440 !Config Key = solarcondate 423 441 !Config Desc = 424 !Config Def = 1993.4 442 !Config Def = 1993.4 ## Average solar cycle condition 425 443 !Config Help = 426 444 ! … … 484 502 write(numout,*)' ok_chem = ',ok_chem 485 503 write(numout,*)' ok_sedim = ',ok_sedim 504 write(numout,*)' ok_deltatemp = ',ok_deltatemp 505 write(numout,*)' nb_mode = ',nb_mode 486 506 write(numout,*)' callnlte = ',callnlte 487 507 write(numout,*)' nltemodel = ',nltemodel -
trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/rcm1d.F
r1403 r1442 8 8 use cpdet_mod, only: ini_cpdet 9 9 use moyzon_mod, only: tmoy 10 USE comvert_mod, ONLY: ap,bp,presnivs,pa,preff,nivsigs,nivsig, 11 . aps,bps,scaleheight,pseudoalt, 12 . disvert_type,pressure_exner 10 13 11 14 IMPLICIT NONE … … 30 33 #include "dimsoil.h" 31 34 #include "comcstfi.h" 32 #include "comvert.h"33 35 #include "netcdf.inc" 34 36 #include "logic.h" … … 77 79 character*2 str2 78 80 79 c normalement dans dyn3d/comconst .h81 c normalement dans dyn3d/comconst_mod.F90 80 82 COMMON/cpdetvenus/cppdyn,nu_venus,t0_venus 81 83 REAL cppdyn,nu_venus,t0_venus -
trunk/LMDZ.VENUS/libf/phyvenus/euvheat.F90
r1310 r1442 1 SUBROUTINE euvheat(nlon, nlev, pt,pplev,pplay,zzlay, &1 SUBROUTINE euvheat(nlon, nlev,nqmx, pt,pplev,pplay,zzlay, & 2 2 mu0,ptimestep,ptime,zday, & 3 co2vmr_gcm, n2vmr_gcm, covmr_gcm, &4 o3pvmr_gcm,nvmr_gcm,pdteuv) 5 3 pq, pdq, pdteuv) 4 5 use chemparam_mod 6 6 use dimphy 7 7 use conc, only: rnew, cpnew 8 8 9 IMPLICIT NONE 9 10 !======================================================================= … … 31 32 ! ------------------ 32 33 ! 33 #include "dimensions.h"34 !#include "dimensions.h" 34 35 #include "YOMCST.h" 35 36 #include "clesphys.h" 36 !#include "comdiurn.h"37 37 #include "param.h" 38 38 #include "param_v4.h" 39 39 !#include "chimiedata.h" 40 !#include "tracer.h"41 40 #include "mmol.h" 42 41 !----------------------------------------------------------------------- … … 47 46 integer :: nlon 48 47 integer :: nlev 48 integer :: nqmx 49 49 50 50 real :: pt(nlon,nlev) … … 56 56 real :: ptimestep,ptime 57 57 real :: zday 58 ! real :: pq(nlon,nlev,nqmx) 59 ! real :: pdq(nlon,nlev,nqmx) 60 real :: co2vmr_gcm(nlon,nlev), n2vmr_gcm(nlon,nlev) 61 real :: covmr_gcm(nlon,nlev), o3pvmr_gcm(nlon,nlev) 62 real :: nvmr_gcm(nlon,nlev) 58 real :: pq(nlon,nlev,nqmx) 59 real :: pdq(nlon,nlev,nqmx) 63 60 real :: pdteuv(nlon,nlev) 64 61 ! 65 62 ! Local variables : 66 63 ! ----------------- 67 integer,save :: nespeuv=17 ! Number of species considered (11, 12 or 17) 64 65 integer,save :: nespeuv=17 ! Number of species considered (11, 12 or 17 (with nitrogen)) 66 integer,save :: nspeuv_vgcm ! Number of species considered currently considered into VGCM 67 68 68 69 69 INTEGER :: l,ig,n 70 integer,save :: euvmod = 0 !0: Hedin profiles 5 species1: O3 chemistry 2: N chemistry, 3: C/O/H71 real, allocatable :: rm(:,:) ! number density (cm-3)72 !real :: zq(nlon,nlev,nqmx) ! local updated tracer quantity70 integer,save :: euvmod = 0 !0: 4 (main) species 1: O3 chemistry 2: N chemistry, 3: C/O/H 71 real, allocatable, save :: rm(:,:) ! number density (cm-3) 72 real :: zq(nlon,nlev,nqmx) ! local updated tracer quantity 73 73 real :: zt(nlon,nlev) ! local updated atmospheric temperature 74 74 real :: zlocal(nlev) … … 82 82 !!! If the values are changed there, the same has to be done here !!! 83 83 84 integer,parameter :: i_co2=1 85 integer,parameter :: i_o=3 86 integer,parameter :: i_co=4 87 integer,parameter :: i_n2=13 88 integer,parameter :: i_n=14 89 90 ! integer,parameter :: i_o2=2 91 ! integer,parameter :: i_h=5 92 ! integer,parameter :: i_oh=6 93 ! integer,parameter :: i_ho2=7 94 ! integer,parameter :: i_h2=8 95 ! integer,parameter :: i_h2o=9 96 ! integer,parameter :: i_h2o2=10 97 ! integer,parameter :: i_o1d=11 98 ! integer,parameter :: i_o3=12 99 ! integer,parameter :: i_no=15 100 ! integer,parameter :: i_n2d=16 101 ! integer,parameter :: i_no2=17 102 84 integer,parameter :: ix_co2=1 85 integer,parameter :: ix_o=3 86 integer,parameter :: ix_co=4 87 integer,parameter :: ix_n2=13 88 89 90 ! Tracer indexes in the GCM: 91 integer,save :: g_co2=0 92 integer,save :: g_o=0 93 integer,save :: g_co=0 94 integer,save :: g_n2=0 103 95 104 ! Tracer indexes in the GCM:105 ! integer,save :: g_co2=0106 ! integer,save :: g_o=0107 ! integer,save :: g_o2=0108 ! integer,save :: g_h2=0109 ! integer,save :: g_h2o2=0110 ! integer,save :: g_h2o=0111 ! integer,save :: g_o3=0112 ! integer,save :: g_n2=0113 ! integer,save :: g_n=0114 ! integer,save :: g_no=0115 ! integer,save :: g_co=0116 ! integer,save :: g_h=0117 ! integer,save :: g_no2=0118 ! integer,save :: g_oh=0119 ! integer,save :: g_ho2=0120 ! integer,save :: g_o1d=0121 ! integer,save :: g_n2d=0122 123 124 96 logical,save :: firstcall=.true. 125 97 … … 127 99 128 100 129 !if (firstcall) then130 ! nespeuv=0131 ! identify the indexes of the tracers we'll need132 ! g_co2=igcm_co2133 !if (g_co2.eq.0) then134 !write(*,*) "euvheat: Error; no CO2 tracer !!!"135 !write(*,*) "CO2 is always needed if calleuv=.true."136 !stop137 !else138 ! nespeuv=nespeuv+1139 !endif140 ! g_o=igcm_o141 !if (g_o.eq.0) then142 !write(*,*) "euvheat: Error; no O tracer !!!"101 if (firstcall) then 102 nspeuv_vgcm=0 103 ! ! identify the indexes of the tracers we'll need 104 g_co2=i_co2 105 if (g_co2.eq.0) then 106 write(*,*) "euvheat: Error; no CO2 tracer !!!" 107 write(*,*) "CO2 is always needed if calleuv=.true." 108 stop 109 else 110 nspeuv_vgcm=nspeuv_vgcm+1 111 endif 112 g_o=i_o 113 if (g_o.eq.0) then 114 write(*,*) "euvheat: Error; no O tracer !!!" 143 115 ! write(*,*) "O is always needed if calleuv=.true." 144 ! stop 145 ! else 146 ! nespeuv=nespeuv+1 147 ! endif 116 stop 117 else 118 nspeuv_vgcm=nspeuv_vgcm+1 119 endif 120 g_co=i_co 121 if (g_co.eq.0) then 122 write(*,*) "euvheat: Error; no CO tracer !!!" 123 ! write(*,*) "CO is always needed if calleuv=.true." 124 stop 125 else 126 nspeuv_vgcm=nspeuv_vgcm+1 127 endif 128 ! n2 129 g_n2=i_n2 130 if (g_n2.eq.0) then 131 write(*,*) "euvheat: Error; no N2 tracer !!!" 132 ! write(*,*) "N2 needed if NO is in traceur.def" 133 stop 134 else 135 nspeuv_vgcm=nspeuv_vgcm+1 136 endif 137 148 138 ! g_o2=igcm_o2 149 139 ! if (g_o2.eq.0) then … … 201 191 ! else 202 192 ! nespeuv=nespeuv+1 203 ! endif204 ! g_co=igcm_co205 ! if (g_co.eq.0) then206 ! write(*,*) "euvheat: Error; no CO tracer !!!"207 ! write(*,*) "CO is always needed if calleuv=.true."208 ! stop209 ! else210 ! nespeuv=nespeuv+1211 193 ! endif 212 194 ! g_h=igcm_h … … 242 224 ! euvmod=2 243 225 ! endif 244 ! n2245 ! g_n2=igcm_n2246 ! if(euvmod.eq.2) then247 ! if (g_n2.eq.0) then248 ! write(*,*) "euvheat: Error; no N2 tracer !!!"249 ! write(*,*) "N2 needed if NO is in traceur.def"250 ! stop251 ! else252 ! nespeuv=nespeuv+1253 ! endif254 ! endif ! Of if(euvmod.eq.2)255 226 ! N 256 227 ! g_n=igcm_n … … 332 303 ! endif 333 304 ! end select 334 335 firstcall= .false.336 ! endif ! of if (firstcall)337 338 !cccccccccccccccccccccccccccccccccccccccccccccccccccccccc339 340 !Number of species if not firstcall341 305 342 306 343 307 !Allocate density vector 344 308 allocate(rm(nlev,nespeuv)) 309 310 firstcall= .false. 311 endif ! of if (firstcall) 312 313 ! write(*,*), "CHECK n species currently used into VGCM", nspeuv_vgcm 314 315 316 !cccccccccccccccccccccccccccccccccccccccccccccccccccccccc 317 345 318 ! build local updated values of tracers (if any) and temperature 319 346 320 do l=1,nlev 347 321 do ig=1,nlon 322 348 323 ! chemical species 349 ! zq(ig,l,g_co2)=pq(ig,l,g_co2)+pdq(ig,l,g_co2)*ptimestep 350 ! ..... (no tracers yet) /// 351 352 ! atmospheric temperature 353 ! zt(ig,l)=pt(ig,l)+pdt(ig,l)*ptimestep 324 zq(ig,l,g_co2)=pq(ig,l,g_co2) 325 zq(ig,l,g_co)=pq(ig,l,g_co) 326 zq(ig,l,g_o)=pq(ig,l,g_o) 327 zq(ig,l,g_n2)=pq(ig,l,g_n2) 328 329 ! atmospheric temperature 354 330 zt(ig,l)=pt(ig,l) 331 332 ! write(*,*), "CHECK update densities L332 euv", zq(ig,l,g_co2) 333 334 355 335 enddo 356 336 enddo … … 369 349 370 350 do l=1,nlev 371 !Conversion to number density 372 373 !! VERS 1 use universal gas constant R = kb * Na 374 ! dens=pplay(ig,l)/(RKBOL*zt(ig,l)*1.e6) ! (1.e6: [m-3] ---> [cm-3] 375 376 ! rm(l,i_co2) = co2vmr_gcm(ig,l) * dens 377 ! rm(l,i_o) = o3pvmr_gcm(ig,l) *dens 378 ! rm(l,i_co) = covmr_gcm(ig,l) * dens 379 ! rm(l,i_n2) = n2vmr_gcm(ig,l) * dens 380 ! rm(l,i_n) = nvmr_gcm(ig,l) * dens 381 382 351 352 ! Conversion to number density 383 353 384 !!! VERS 2: use R specific = R/MolarMass 385 386 dens=pplay(ig,l)/(rnew(ig,l)*zt(ig,l)) / 1.66e-21 ! [g mol-1] [cm-3] 387 388 rm(l,i_co2) = co2vmr_gcm(ig,l) * dens / mmolco2 ! [cm-3] 389 rm(l,i_o) = o3pvmr_gcm(ig,l) *dens / mmolo 390 rm(l,i_co) = covmr_gcm(ig,l) * dens / mmolco 391 rm(l,i_n2) = n2vmr_gcm(ig,l) * dens / mmoln2 392 rm(l,i_n) = nvmr_gcm(ig,l) * dens / mmoln 393 394 ! if(ig .eq. 1 .and. l .eq. 50) then 395 ! print*,'---EUV ---' 396 ! print*,i_co2, 'rm:', rm(l,i_co2), 'covmr:',co2vmr_gcm(ig,l), pplay(ig,l), zt(ig,l) 397 ! print*,'dens:', pplay(ig,l)/(RKBOL*zt(ig,l)*1.e6) 398 ! print*, 'rnew:', rnew(ig,l) !, 'dens2:', pplay(ig,l)/(rnew(ig,l)*zt(ig,l))/ 1.66e-21 399 ! endif 354 !!! use R specific = R/MolarMass 355 356 dens=pplay(ig,l)/(rnew(ig,l)*zt(ig,l)) / 1.66e-21 ! [g mol-1] [cm-3] 357 358 rm(l,ix_co2) = zq(ig,l,g_co2) * dens / M_tr(g_co2) ! [cm-3] 359 rm(l,ix_o) = zq(ig,l,g_o) * dens / M_tr(g_o) 360 rm(l,ix_co) = zq(ig,l,g_co) * dens / M_tr(g_co) 361 rm(l,ix_n2) = zq(ig,l,g_n2) * dens / M_tr(g_n2) 362 363 ! write(*,*), "CHECK n density", l, rm(l,ix_co2) 364 400 365 401 366 enddo … … 415 380 call hrtherm (ig,euvmod,rm,nespeuv,tx,zlocal,zenit,zday,jtot) 416 381 417 ! value for the UV heating efficiency418 ! (experimental values between 0.19 and 0.23, lower values may419 ! be used to compensate for low 15 um cooling)420 ! read in physiq.def421 ! default value: euveff=0.21 !Fox1988422 382 423 383 !Calculates the UV heating from the total photoabsorption coefficient … … 427 387 /(cpnew(ig,l)*pplay(ig,l)/(rnew(ig,l)*zt(ig,l))) 428 388 429 430 ! !The solar flux calculated in431 !flujo.F is already corrected for432 !the actual Venus-Sun distance433 434 ! print*, 'EUV heat'435 ! print*, ig, l, pdteuv(ig,l), euveff, jtot(l), cpnew(ig, l), rnew(ig,l)436 ! stop437 438 389 enddo 439 390 enddo ! of do ig=1,nlon 391 440 392 !Deallocations 441 deallocate(rm)393 !deallocate(rm) 442 394 443 395 return -
trunk/LMDZ.VENUS/libf/phyvenus/hrtherm.F
r1310 r1442 79 79 xabsi(3,i) = rm(i,i_o) 80 80 xabsi(8,i) = rm(i,i_n2) 81 xabsi(9,i) = rm(i,i_n)82 81 xabsi(11,i) = rm(i,i_co) 83 82 … … 116 115 jtot(i)=jtot(i)+jergs(indexint,j,i) 117 116 118 c if (j .eq. 1 .and. i .eq. 60) then 119 c print*, '-- hrtherm 2---' 120 c print*, indexint, j,i, xabsi(j,i), jfotsout(indexint,j,i), 121 c $ fluxtop(indexint), freccen(indexint) 122 c end if 117 123 118 end do 124 119 end do -
trunk/LMDZ.VENUS/libf/phyvenus/ini_histins.h
r1305 r1442 102 102 c 103 103 c plusieurs traceurs 104 if (iflag_trac.eq.1) THEN104 if (ok_chem) THEN 105 105 DO iq=1,nqmax 106 c DO iq=1,10 106 107 IF (iq.LE.99) THEN 107 108 WRITE(str2,'(i2.2)') iq 108 CALL histdef(nid_ins, tname(iq), ttext(iq), " vmr",109 CALL histdef(nid_ins, tname(iq), ttext(iq), "mol/mol", 109 110 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 110 111 . "ins(X)", zsto,zout) … … 114 115 ENDIF 115 116 ENDDO 116 endif 117 CALL histdef(nid_mth, "d_qmoldif CO2", "Dif molec" , "kg/kg", 118 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 119 . "ave(X)", zsto,zout) 120 CALL histdef(nid_mth, "d_qmoldif O3p", "Dif molec" , "kg/kg", 121 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 122 . "ave(X)", zsto,zout) 123 CALL histdef(nid_mth, "d_qmoldif N2", "Dif molec" , "kg/kg", 124 . iim,jj_nb,nhori, klev,1,klev,nvert, 32, 125 . "ave(X)", zsto,zout) 126 127 endif 117 128 c 118 129 CALL histdef(nid_ins, "tops", "Solar rad. at TOA", "W/m2", … … 120 131 . "ins(X)", zsto,zout) 121 132 c 122 if (ok_cloud) THEN 123 CALL histdef(nid_ins, "NBRTOT", "Nbr total droplet", "#/cm3", 124 . iim,jj_nb,nhori, klev,1,klev, nvert, 32, 125 . "ins(X)", zsto,zout) 126 CALL histdef(nid_ins, "WH2SO4", "Weight fraction H2SO4", 127 . "fraction",iim,jj_nb,nhori, klev,1,klev, nvert, 32, 128 . "ins(X)", zsto,zout) 129 CALL histdef(nid_ins, "R_MEDIAN", 130 . "Median radius fo log normal distribution" , 131 . "fraction",iim,jj_nb,nhori, klev,1,klev, nvert, 32, 132 . "ins(X)", zsto,zout) 133 CALL histdef(nid_ins, "STDDEV", 134 . "Std Deviation for lor normaldistribution", 135 . "fraction",iim,jj_nb,nhori, klev,1,klev, nvert, 32, 136 . "ins(X)", zsto,zout) 137 CALL histdef(nid_ins, "rho_droplet", "density cloud droplet", 138 . "kg.m-3",iim,jj_nb,nhori, klev,1,klev, nvert, 32, 139 . "ins(X)", zsto,zout) 140 endif 141 142 if (ok_sedim) THEN 143 CALL histdef(nid_ins,"d_tr_sed_H2SO4","H2SO4 mmr from sedim", 144 . "kg/kg",iim,jj_nb,nhori, klev,1,klev, nvert, 32, 145 . "ins(X)", zsto,zout) 146 CALL histdef(nid_ins,"d_tr_sed_H2O", "H2O mmr from sedim", 147 . "kg/kg",iim,jj_nb,nhori, klev,1,klev, nvert, 32, 148 . "ins(X)", zsto,zout) 149 CALL histdef(nid_ins, "F_sedim", "tendency from sedim", 150 . "kg.m-2.s-1",iim,jj_nb,nhori, klev,1,klev, nvert, 32, 151 . "ins(X)", zsto,zout) 152 endif 153 133 if (ok_cloud) THEN 134 135 if (nb_mode.GE.1) THEN 136 137 c 138 CALL histdef(nid_ins, "NBRTOTm1", "Nbr total droplet", 139 . "#/cm3", iim,jj_nb,nhori, klev,1,klev, nvert, 32, 140 . "ins(X)", zsto,zout) 141 c 142 143 c 144 c CALL histdef(nid_ins, "R_MEDIANm1", "Median radius 145 c . for log normal distribution" , 146 c . "fraction", 147 c . iim,jj_nb,nhori, klev,1,klev, nvert, 32, 148 c . "ins(X)", zsto,zout) 149 c 150 151 c 152 c CALL histdef(nid_ins, "STDDEVm1", "Std Deviation 153 c . for log normal distribution", 154 c . "fraction", 155 c . iim,jj_nb,nhori, klev,1,klev, nvert, 32, 156 c . "ins(X)", zsto,zout) 157 c 158 159 if (nb_mode.GE.2) THEN 160 161 c 162 CALL histdef(nid_ins, "NBRTOTm2", "Nbr total droplet", 163 . "#/cm3", iim,jj_nb,nhori, klev,1,klev, nvert, 32, 164 . "ins(X)", zsto,zout) 165 c 166 167 c 168 c CALL histdef(nid_ins, "R_MEDIANm2", "Median radius 169 c . for log normal distribution" , 170 c . "fraction", 171 c . iim,jj_nb,nhori, klev,1,klev, nvert, 32, 172 c . "ins(X)", zsto,zout) 173 c 174 175 c 176 c CALL histdef(nid_ins, "STDDEVm2", "Std Deviation 177 c . for log normal distribution", 178 c . "fraction", 179 c . iim,jj_nb,nhori, klev,1,klev, nvert, 32, 180 c . "ins(X)", zsto,zout) 181 c 182 183 if (nb_mode.GE.3) THEN 184 185 c 186 CALL histdef(nid_ins, "NBRTOTm3", "Nbr total droplet", "#/cm3", 187 . iim,jj_nb,nhori, klev,1,klev, nvert, 32, 188 . "ins(X)", zsto,zout) 189 c 190 191 c 192 c CALL histdef(nid_ins, "R_MEDIANm3", "Median radius 193 c . for log normal distribution" , 194 c . "fraction", 195 c . iim,jj_nb,nhori, klev,1,klev, nvert, 32, 196 c . "ins(X)", zsto,zout) 197 c 198 199 c 200 c CALL histdef(nid_ins, "STDDEVm3", "Std Deviation 201 c . for log normal distribution", 202 c . "fraction", 203 c . iim,jj_nb,nhori, klev,1,klev, nvert, 32, 204 c . "ins(X)", zsto,zout) 205 c 206 207 ENDIF 208 ENDIF 209 ENDIF 210 211 c 212 CALL histdef(nid_ins, "WH2SO4", "Weight fraction H2SO4", 213 . "fraction", 214 . iim,jj_nb,nhori, klev,1,klev, nvert, 32, 215 . "ins(X)", zsto,zout) 216 c 217 218 c 219 CALL histdef(nid_ins, "rho_droplet", "density cloud droplet", 220 . "kg.m-3", 221 . iim,jj_nb,nhori, klev,1,klev, nvert, 32, 222 . "ins(X)", zsto,zout) 223 c 224 225 ENDIF 226 227 if (ok_sedim) THEN 228 c 229 CALL histdef(nid_ins, "d_tr_sed_H2SO4", "var mmr from sedim", 230 . "kg/kg", 231 . iim,jj_nb,nhori, klev,1,klev, nvert, 32, 232 . "ins(X)", zsto,zout) 233 c 234 235 c 236 CALL histdef(nid_ins, "d_tr_sed_H2O", "var mmr from sedim", 237 . "kg/kg", 238 . iim,jj_nb,nhori, klev,1,klev, nvert, 32, 239 . "ins(X)", zsto,zout) 240 c 241 242 c 243 CALL histdef(nid_ins, "F_sedim", "tendency from sedim", 244 . "kg.m-2.s-1", 245 . iim,jj_nb,nhori, klev,1,klev, nvert, 32, 246 . "ins(X)", zsto,zout) 247 c 248 ENDIF 154 249 ENDIF !lev_histins.GE.2 155 250 c -
trunk/LMDZ.VENUS/libf/phyvenus/jthermcalc.F
r1310 r1442 14 14 use dimphy 15 15 use conc 16 c use chemparam_mod 16 17 implicit none 17 18 18 19 c common variables and constants 19 #include "dimensions.h"20 #include "param.h"21 #include "param_v4.h"20 include "dimensions.h" 21 include "param.h" 22 include "param_v4.h" 22 23 23 24 c input and output variables … … 37 38 real o3pcolx(klev) !column density of O(3P)(cm^-2) 38 39 real n2colx(klev) !N2 column density (cm-2) 39 real ncolx(klev) !N column density (cm-2)40 40 real cocolx(klev) !CO column density (cm-2) 41 41 c real o2colx(klev) !column density of O2(cm^-2) … … 68 68 c real*8 auxjo3(nz2) 69 69 real*8 auxjn2(nz2) 70 real*8 auxjn(nz2)70 c real*8 auxjn(nz2) 71 71 c real*8 auxjno(nz2) 72 72 real*8 auxjco(nz2) … … 84 84 85 85 86 87 88 89 90 integer,parameter :: i _co2=191 integer,parameter :: i _n2=1392 integer,parameter :: i_n=1493 integer,parameter :: i _o=394 integer,parameter :: i _co=486 ! Tracer indexes in the thermospheric chemistry: 87 !!! ATTENTION. These values have to be identical to those in euvheat.F90 88 !!! If the values are changed there, the same has to be done here !!! 89 90 integer,parameter :: ix_co2=1 91 integer,parameter :: ix_n2=13 92 c integer,parameter :: i_n=14 93 integer,parameter :: ix_o=3 94 integer,parameter :: ix_co=4 95 95 96 96 … … 118 118 119 119 !Calculation of column amounts 120 c call column(ig,chemthermod,rm,nesptherm,tx,iz,zenit,121 c $ co2colx,o2colx,o3pcolx,h2colx,h2ocolx,122 c $ h2o2colx,o3colx,n2colx,ncolx,nocolx,cocolx,hcolx,no2colx)123 120 call column(ig,chemthermod,rm,nesptherm,tx,iz,zenit, 124 $ co2colx,o3pcolx, n2colx, ncolx,cocolx)121 $ co2colx,o3pcolx, n2colx,cocolx) 125 122 126 123 !Auxiliar column to include the temperature dependence … … 129 126 do i=klev-1,1,-1 130 127 coltemp(i)=!coltemp(i+1)+ PQ SE ELIMINA? REVISAR 131 $ ( rm(i,i _co2) + rm(i+1,i_co2) ) * 0.5128 $ ( rm(i,ix_co2) + rm(i+1,ix_co2) ) * 0.5 132 129 $ * 1e5 * (iz(i+1)-iz(i)) * abs(t2(i)-t0(i)) 133 130 end do … … 162 159 auxcolinp(klev-i+1) = co2colx(i)*crscabsi2(1,indexint) + 163 160 c $ o2colx(i)*crscabsi2(2,indexint) + 164 $ o3pcolx(i)*crscabsi2(3,indexint) +161 $ o3pcolx(i)*crscabsi2(3,indexint) 165 162 c $ h2colx(i)*crscabsi2(5,indexint) + 166 $ ncolx(i)*crscabsi2(9,indexint)167 163 end do 168 164 limdown=1.e-20 … … 183 179 c auxjh2(i) = jabsifotsintpar(auxi,5,indexint) 184 180 !N tabulated coefficient 185 auxjn(i) = jabsifotsintpar(auxi,9,indexint)181 c auxjn(i) = jabsifotsintpar(auxi,9,indexint) 186 182 !Tabulated column 187 183 auxcoltab(i) = c1_16(auxi,indexint) … … 214 210 c $ wp(i)*auxjh2(ind) 215 211 c !N interpolated coefficient 216 jfotsout(indexint,9,auxi) = wm(i)*auxjn(ind+1) +217 $ wp(i)*auxjn(ind)218 219 c print*, '--- 1jthermcal.F ---'220 cprint*, jfotsout(indexint,1,auxi)212 c jfotsout(indexint,9,auxi) = wm(i)*auxjn(ind+1) + 213 c $ wp(i)*auxjn(ind) 214 215 C print*, '--- L214 jthermcal.F ---' 216 C print*, jfotsout(indexint,1,auxi) 221 217 c STOP 222 223 218 224 219 enddo … … 252 247 $ o3pcolx(i)*crscabsi2(3,indexint)+ 253 248 $ n2colx(i)*crscabsi2(8,indexint)+ 254 $ ncolx(i)*crscabsi2(9,indexint)+255 249 $ cocolx(i)*crscabsi2(11,indexint) 256 250 … … 277 271 auxjn2(i) = jabsifotsintpar(auxi,8,indexint) 278 272 !N tabulated coefficient 279 auxjn(i) = jabsifotsintpar(auxi,9,indexint)273 c auxjn(i) = jabsifotsintpar(auxi,9,indexint) 280 274 !CO tabulated coefficient 281 275 auxjco(i) = jabsifotsintpar(auxi,11,indexint) … … 319 313 $ wp(i)*auxjn2(ind) 320 314 !N interpolated coefficient 321 jfotsout(indexint,9,auxi) = wm(i)*auxjn(ind+1) +322 $ wp(i)*auxjn(ind)315 c jfotsout(indexint,9,auxi) = wm(i)*auxjn(ind+1) + 316 c $ wp(i)*auxjn(ind) 323 317 !CO interpolated coefficient 324 318 jfotsout(indexint,11,auxi) = wm(i)*auxjco(ind+1) + … … 364 358 $ o3pcolx(i)*crscabsi2(3,indexint)+ 365 359 $ n2colx(i)*crscabsi2(8,indexint)+ 366 $ ncolx(i)*crscabsi2(9,indexint)+367 c $ nocolx(i)*crscabsi2(10,indexint)+368 360 $ cocolx(i)*crscabsi2(11,indexint) 369 361 c $ hcolx(i)*crscabsi2(12,indexint)+ … … 386 378 auxjco(i) = jabsifotsintpar(auxi,11,indexint) 387 379 c !N tabulated coefficient 388 auxjn(i) = jabsifotsintpar(auxi,9,indexint)380 c auxjn(i) = jabsifotsintpar(auxi,9,indexint) 389 381 390 382 !NO tabulated coefficient … … 432 424 $ wp(i)*auxjco(ind) 433 425 !N interpolated coefficient 434 jfotsout(indexint,9,auxi) = wm(i)*auxjn(ind+1) +435 $ wp(i)*auxjn(ind)426 c jfotsout(indexint,9,auxi) = wm(i)*auxjn(ind+1) + 427 c $ wp(i)*auxjn(ind) 436 428 437 429 c !H interpolated coefficient … … 1057 1049 c********************************************************************** 1058 1050 1059 c subroutine column(ig,chemthermod,rm,nesptherm,tx,iz,zenit,1060 c $ co2colx,o2colx,o3pcolx,h2colx,h2ocolx,h2o2colx,o3colx,1061 c $ n2colx,ncolx,nocolx,cocolx,hcolx,no2colx)1062 1051 subroutine column(ig,chemthermod,rm,nesptherm,tx,iz,zenit, 1063 $ co2colx,o3pcolx, n2colx, ncolx,cocolx)1052 $ co2colx,o3pcolx, n2colx, cocolx) 1064 1053 1065 1054 c mar 2014 gg adapted to Venus GCM … … 1087 1076 integer ig 1088 1077 integer chemthermod 1089 integer nesptherm 1078 integer nesptherm !# of species undergoing chemistry, input 1090 1079 real rm(klev,nesptherm) !densities (cm-3), input 1091 1080 real tx(klev) !temperature profile, input … … 1095 1084 real o3pcolx(klev) !column density of O(3P)(cm^-2), output 1096 1085 real n2colx(klev) !N2 column density (cm-2), output 1097 real ncolx(klev) !N column density (cm-2), output1098 1086 real cocolx(klev) !CO column density (cm-2), output 1099 1087 … … 1149 1137 real*8 szadeg 1150 1138 1151 ! Tracer indexes in the thermospheric chemistry: 1152 !!! ATTENTION. These values have to be identical to those in euvheat.F90 1153 !!! If the values are changed there, the same has to be done here !!! 1154 1155 integer,parameter :: i_co2=1 1156 integer,parameter :: i_n2=13 1157 integer,parameter :: i_n=14 1158 integer,parameter :: i_o=3 1159 integer,parameter :: i_co=4 1139 ! Tracer indexes in the thermospheric chemistry: 1140 !!! ATTENTION. These values have to be identical to those in euvheat.F90 1141 !!! If the values are changed there, the same has to be done here !!! 1142 1143 integer,parameter :: ix_co2=1 1144 integer,parameter :: ix_n2=13 1145 integer,parameter :: ix_o=3 1146 integer,parameter :: ix_co=4 1160 1147 1161 1148 c*************************PROGRAM STARTS******************************* … … 1193 1180 o3pcolx(i) = 0. 1194 1181 n2colx(i) = 0. 1195 ncolx(i) = 0.1196 1182 cocolx(i) = 0. 1197 1183 1198 1184 !--Densities [cm-3] 1199 co2x(i) = rm(i,i_co2) 1200 o3px(i) = rm(i,i_o) 1201 cox(i) = rm(i,i_co) 1202 n2x(i) = rm(i,i_n2) 1203 nx(i) = rm(i,i_n) 1185 co2x(i) = rm(i,ix_co2) 1186 o3px(i) = rm(i,ix_o) 1187 cox(i) = rm(i,ix_co) 1188 n2x(i) = rm(i,ix_n2) 1189 1190 c write(*,*), '--jthermcalc--', co2x(i) 1204 1191 1205 1192 !Only if O3 chem. required … … 1223 1210 o3pcolx(i)=1.e25 1224 1211 n2colx(i)=1.e25 1225 ncolx(i)=1.e251226 1212 cocolx(i)=1.e25 1227 1213 … … 1232 1218 c h2o2colx(i)=1.e25 1233 1219 c o3colx(i)=1.e25 1234 c n2colx(i)=1.e251235 1220 c ncolx(i)=1.e25 1236 1221 c nocolx(i)=1.e25 … … 1256 1241 n2colx(i)=n2colx(i)+n2x(klev)*Hn2*esp(j) 1257 1242 $ *1.e-5 1258 ncolx(i)=ncolx(i)+nx(klev)*Hn*esp(j)1259 $ *1.e-51260 1243 1261 1244 c h2o2colx(i)=h2o2colx(i)+ … … 1279 1262 c n2colx(i)=n2colx(i)+n2x(klev)*Hn2*esp(j) 1280 1263 c $ *1.e-5 1281 c ncolx(i)=ncolx(i)+nx(klev)*Hn*esp(j) 1282 c $ *1.e-5 1283 c nocolx(i)=nocolx(i)+nox(klev)*Hno*esp(j) 1284 c $ *1.e-5 1285 c no2colx(i)=no2colx(i)+no2x(klev)*Hno2*esp(j) 1286 c $ *1.e-5 1264 1287 1265 c endif 1288 1266 else if(zenit.gt.60.) then … … 1313 1291 cocolx(i) = cocolx(i) + espco*cox(klev) 1314 1292 n2colx(i) = n2colx(i) + espn2*n2x(klev) 1315 ncolx(i) = ncolx(i) + espn*nx(klev)1316 1293 1317 1294 c o2colx(i) = o2colx(i) + espo2*o2x(klev) … … 1342 1319 n2colx(i) = n2colx(i) + 1343 1320 $ esp(j) * (n2x(jj)+n2x(jj+1)) / 2. 1344 ncolx(i) = ncolx(i) + 1345 $ esp(j) * (nx(jj)+nx(jj+1)) / 2. 1321 1346 1322 c 1347 1323 c o2colx(i) = o2colx(i) + … … 1734 1710 1735 1711 real date 1736 integer, parameter :: dateyr = 20061712 c integer, parameter :: dateyr = 2006 1737 1713 1738 1714 ! Local variable and constants 1739 real, parameter :: dist_sol=0.72 1715 ! dist_sol : distance venus - soleil 1716 1717 real, parameter :: dist_sol=0.72333 1740 1718 integer i 1741 1719 integer inter … … 1744 1722 !c************************************************* 1745 1723 1746 if(date yr.lt.1985.) date=1985.1747 if(date yr.gt.2001.) date=2001.1724 if(date.lt.1985.) date=1985. 1725 if(date.gt.2001.) date=2001. 1748 1726 1749 1727 do i=1,ninter … … 1761 1739 ! is corrected for 1762 1740 ! the actual Venus-Sun dist 1763 fluxtop(i)=fluxtop(i)*(1/dist_sol)**2 1764 1765 !TEST 1766 c fluxtop(i) = fluxtop(i)*10 1741 fluxtop(i)=fluxtop(i)*(1./dist_sol)**2 1742 1767 1743 1768 1744 end do -
trunk/LMDZ.VENUS/libf/phyvenus/new_cloud_sedim.F
r1305 r1442 1 1 SUBROUTINE new_cloud_sedim(n_lon,n_lev,ptimestep, 2 2 & pmidlay,pbndlay, 3 & pt, wgt_h2so4,pq,nq,Np,rho_p,4 & F_sed,pdqsed,pdqs_sed)3 & pt, 4 & pq, pdqsed,pdqs_sed,nq,F_sed) 5 5 6 6 USE ioipsl … … 36 36 REAL pt(n_lon,n_lev) ! temperature at mid-layer (l) 37 37 REAL pbndlay(n_lon,n_lev+1) ! pressure at layer boundaries 38 c Aerosol radius provided by the water ice microphysical scheme:39 c rdroplet non utilise ???40 c REAL rdroplet(n_lon,n_lev) ! Dust geometric mean radius (m)41 c REAL rice(n_lon,n_lev) ! Ice geometric mean radius (m)42 REAL wgt_h2so4(n_lon,n_lev) ! Fraction of H2SO4 in droplet43 38 44 39 c Traceurs : … … 51 46 c local: 52 47 c ------ 53 48 integer imode 54 49 integer ig 55 50 integer iq … … 60 55 real zqi_wv(n_lon,n_lev) ! to locally store H2O tracer 61 56 real zqi_sa(n_lon,n_lev) ! to locally store H2SO4 tracer 62 real m_lay (n_lon,n_lev) ! Layer Pressure over g avity (Dp/g == kg.m-2)57 real m_lay (n_lon,n_lev) ! Layer Pressure over gravity (Dp/g == kg.m-2) 63 58 real wq(n_lon,n_lev+1) ! displaced tracer mass (kg.m-2) 64 59 … … 66 61 c ~~~~~~~~~~~~~~~~~ 67 62 c Gas molecular viscosity (N.s.m-2) 68 real,parameter :: visc=1.e-5 ! CO2 63 c real,parameter :: visc=1.e-5 ! CO2 64 REAL :: VISCOSITY_CO2 69 65 c Effective gas molecular radius (m) 70 66 real,parameter :: molrad=2.2e-10 ! CO2 … … 72 68 c Cloud density (kg.m-3) 73 69 c ~~~~~~~~~~~~~~~~~~~~~~ 74 real, DIMENSION(n_lon,n_lev) :: rho_p 70 c real, DIMENSION(n_lon,n_lev) :: rho_droplet 75 71 76 72 REAL, DIMENSION(n_lon,n_lev+1) :: … … 85 81 + l_mean, ! libre parcours moyen (m) 86 82 + a,b_exp,c ! coeff du calcul du Flux de sedimentation 87 REAL, DIMENSION(n_lon,n_lev) ::88 + Np ! Nombre de particules (#.cm-3)89 83 REAL, DIMENSION(n_lon,n_lev+1) :: 90 84 + F_sed ! Flux de sedimentation (kg.m-2.s-1 puis en output kg.m-2) … … 94 88 95 89 90 91 ! PRINT*,'RHO_DROPLET new_cloud_sedim.F' 92 ! PRINT*,'rho_droplet',rho_droplet(16,21) 93 ! PRINT*,'T',pt(16,21),'WSA',WH2SO4(16,21) 96 94 97 95 c----------------------------------------------------------------------- … … 106 104 zqi_wv(ig,l) = pq(ig,l,i_h2oliq) 107 105 zqi_sa(ig,l) = pq(ig,l,i_h2so4liq) 108 wgt_SA(ig,l) = wgt_h2so4(ig,l)106 wgt_SA(ig,l) = WH2SO4(ig,l) 109 107 enddo 110 108 enddo 111 112 wgt_SA(:,n_lev+1) = 0.0D0 113 F_sed(:,n_lev+1) = 0.0D0 109 110 c Init F_sed 111 F_sed(:,:) = 0.0E+0 112 113 c Au niveau top+1 , tout égal a 0 114 wgt_SA(:,n_lev+1) = 0.0E+0 114 115 115 116 c Computing the different layer properties 116 117 c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 117 c m_lay (kg.m-2) , thickness(m), crossing time (s) etc.118 c m_lay (kg.m-2) 118 119 c Ici g=8.87, conflit pour g entre #include "YOMCST.h" 119 120 c et #include "comcstfi.h" … … 121 122 do l=1,n_lev 122 123 do ig=1, n_lon 123 m_lay(ig,l)=(pbndlay(ig,l) - pbndlay(ig,l+1)) /8.87 d0124 m_lay(ig,l)=(pbndlay(ig,l) - pbndlay(ig,l+1)) /8.87E+0 124 125 IF (m_lay(ig,l).LE.0.0) THEN 125 126 PRINT*,'!!!! STOP PROBLEME SEDIMENTATION!!!!' … … 134 135 c pbndlay(:,51)=0 (en parallèle c'est sûr), ne pas l'utiliser pour Fse 135 136 136 DO l = 1, n_lev 137 DO ig=1,n_lon 138 139 c On calcule un Flux de sedimentation uniquement pour les couche avec une partie 140 c significative de droplet 141 142 IF ((Np(ig,l).GT.1.0e-20)) THEN 137 DO imode=1, nbr_mode 138 DO l = cloudmin, cloudmax 139 DO ig=1,n_lon 143 140 144 141 c RD=1000.*RNAVO*RKBOL/RMD avec RMD=43.44 Masse molaire atm venus en g.mol-1 145 D_stokes=( rho_p(ig,l)-pmidlay(ig,l)/(RD*pt(ig,l)))146 & * 2./9.*RG/visc142 D_stokes=((rho_droplet(ig,l)-pmidlay(ig,l)/(RD*pt(ig,l)))) 143 & *(2./9.)*(RG/VISCOSITY_CO2(pt(ig,l))) 147 144 148 145 l_mean=(pt(ig,l)/pmidlay(ig,l))* 149 146 & (0.707*R/(4.*RPI* molrad*molrad * RNAVO)) 150 147 151 R_mode0=R_MEDIAN(ig,l)*EXP(-LOG(STDDEV(ig,l))**2.) 152 IF ((l_mean/(R_mode0)).LT.1.) THEN 153 Rp_DL=R_MEDIAN(ig,l)*EXP(3.*LOG(STDDEV(ig,l))**2.) 148 R_mode0=R_MEDIAN(ig,l,imode)* 149 & EXP(-LOG(STDDEV(ig,l,imode))**2.) 150 IF ((l_mean/(R_mode0)).GT.10.) THEN 151 Rp_DL=R_MEDIAN(ig,l,imode)* 152 & EXP(3.*LOG(STDDEV(ig,l,imode))**2.) 154 153 ELSE 155 Rp_DL=R_MEDIAN(ig,l)*EXP(4.*LOG(STDDEV(ig,l))**2.) 154 Rp_DL=R_MEDIAN(ig,l,imode)* 155 & EXP(4.*LOG(STDDEV(ig,l,imode))**2.) 156 156 ENDIF 157 157 … … 168 168 A2=1.-b_exp*(c 169 169 & +Rp_DL*c**2 170 & +0.5* Rp_DL**2*c**3)170 & +0.5*(Rp_DL**2)*(c**3)) 171 171 172 172 A3=0.5*b_exp*(c**2+Rp_DL*c**3) 173 173 174 174 A4=-b_exp*1./6.*c**3 175 176 F_sed(ig,l)=rho_p(ig,l)*4./3.*RPI* 177 & Np(ig,l)*1.0e6*D_stokes*( 178 & A1*R_MEDIAN(ig,l)**4*EXP(8.0*LOG(STDDEV(ig,l))**2.) 179 & +A2*R_MEDIAN(ig,l)**5*EXP(12.5*LOG(STDDEV(ig,l))**2.) 180 & +A3*R_MEDIAN(ig,l)**6*EXP(18.0*LOG(STDDEV(ig,l))**2.) 181 & +A4*R_MEDIAN(ig,l)**7*EXP(24.5*LOG(STDDEV(ig,l))**2.)) 182 183 c PRINT*,' AVANT dTime: F_sed=',F_sed(ig,l), ig, l 184 185 F_sed(ig,l)=F_sed(ig,l)*ptimestep 175 176 c Addition des Flux de tous les modes presents 177 F_sed(ig,l)=F_sed(ig,l)+(rho_droplet(ig,l)*4./3.*RPI* 178 & NBRTOT(ig,l,imode)*1.0E6*D_stokes*( 179 & A1*R_MEDIAN(ig,l,imode)**4 180 & *EXP(8.0*LOG(STDDEV(ig,l,imode))**2.) 181 & +A2*R_MEDIAN(ig,l,imode)**5 182 & *EXP(12.5*LOG(STDDEV(ig,l,imode))**2.) 183 & +A3*R_MEDIAN(ig,l,imode)**6 184 & *EXP(18.0*LOG(STDDEV(ig,l,imode))**2.) 185 & +A4*R_MEDIAN(ig,l,imode)**7 186 & *EXP(24.5*LOG(STDDEV(ig,l,imode))**2.))) 186 187 187 188 c PRINT*,' APRES dTime: F_sed=',F_sed(ig,l), ig, l 188 189 189 c IF (F_sed(ig,l).GT.m_lay(ig,l)) THEN 190 c PRINT*,'===============================================' 191 c PRINT*,'WARNING On a epuise la couche', ig, l 192 c PRINT*,'F_sed:',F_sed(ig,l),'m_lay:',m_lay(ig,l) 193 c PRINT*,'F_sed/dtphy',F_sed(ig,l)/ptimestep 194 c PRINT*,'Pbnd top',pbndlay(ig,l+1),'Temp',pt(ig,l),'Rho', 195 c & rho_p(ig,l) 196 c PRINT*,'Ntot',Np(ig,l),'Ntot m3',Np(ig,l)*1.0e6 197 c PRINT*,'StdDev',STDDEV(ig,l),'Rmed',R_MEDIAN(ig,l) 190 IF (F_sed(ig,l).GT.m_lay(ig,l)) THEN 191 PRINT*,'===============================================' 192 PRINT*,'WARNING On a epuise la couche', ig, l 193 PRINT*,'On epuise pas une couche avec une espèce 194 & minoritaire, c est pas bien maaaaaal' 195 PRINT*,'Water',zqi_wv(ig,l),'Sulfuric Acid',zqi_sa(ig,l) 196 PRINT*,'F_sed:',F_sed(ig,l),'m_lay:',m_lay(ig,l) 197 PRINT*,'F_sed/dtphy',F_sed(ig,l)/ptimestep 198 PRINT*,'Pbnd top',pbndlay(ig,l+1),'Temp',pt(ig,l),'Rho', 199 & rho_droplet(ig,l) 200 PRINT*,'Ntot',NBRTOT(ig,l,:) 201 PRINT*,'StdDev',STDDEV(ig,l,:),'Rmed',R_MEDIAN(ig,l,:) 202 PRINT*,'K_MASS',K_MASS(ig,l,:) 203 PRINT*,'WSA',WH2SO4(ig,l),'RHO',rho_droplet(ig,l) 198 204 199 205 c ELSE … … 204 210 c PRINT*,'F_sed/dtphy',F_sed(ig,l)/ptimestep 205 211 c PRINT*,'Pbnd top',pbndlay(ig,l+1),'Temp',pt(ig,l),'Rho', 206 c & rho_p(ig,l)(ig,l) 207 c PRINT*,'Ntot',Np(ig,l),'Ntot m3',Np(ig,l)*1.0e6 208 c PRINT*,'StdDev',STDDEV(ig,l),'Rmed',R_MEDIAN(ig,l) 209 c ENDIF 210 211 ELSE 212 F_sed(ig,l)=0.0d0 213 ENDIF 214 215 IF (F_sed(ig,l).LT.0.0e0) THEN 212 c & rho_droplet(ig,l)(ig,l) 213 c PRINT*,'Ntot',NBRTOT(ig,l),'Ntot m3',NBRTOT(ig,l)*1.0e6 214 c PRINT*,'StdDev',STDDEV(ig,l),'Rmed',R_MEDIAN(ig,l) 215 STOP 216 ENDIF 217 218 IF (F_sed(ig,l).LT.0.0d0) THEN 216 219 PRINT*,"F_sed est négatif !!!" 217 220 PRINT*,'F_sed:',F_sed(ig,l),'m_lay:',m_lay(ig,l) … … 219 222 PRINT*,'Pbnd top',pbndlay(ig,l+1),'Pmid',pmidlay(ig,l) 220 223 PRINT*,'Temp',pt(ig,l),'Rho', 221 & rho_p(ig,l) 222 PRINT*,'Ntot',Np(ig,l),'Ntot m3',Np(ig,l)*1.0e6 223 PRINT*,'StdDev',STDDEV(ig,l),'Rmed',R_MEDIAN(ig,l) 224 & rho_droplet(ig,l) 225 PRINT*,'Ntot',NBRTOT(ig,l,imode),'Ntot m3', 226 & NBRTOT(ig,l,imode)*1.0e6 227 PRINT*,'StdDev',STDDEV(ig,l,imode),'Rmed', 228 & R_MEDIAN(ig,l,imode) 224 229 PRINT*,'A1',A1,'A2',A2 225 230 PRINT*,'A3',A1,'A4',A2 … … 227 232 STOP 228 233 ENDIF 229 234 235 ENDDO 236 237 c ELSE 238 c F_sed(:,l)=0.0d0 239 c ENDIF 240 230 241 ENDDO 231 242 ENDDO 243 244 c Passage du Flux au Flux pour un pas de temps (== kg.m-2) 245 F_sed(:,:)=F_sed(:,:)*ptimestep 232 246 233 247 … … 243 257 c Partie H2SO4l 244 258 c ~~~~~~~~~~~~ 245 c CALL vlz_fi_par(n_lon,n_lev,zqi_sa,2.,m_lay,F_sed,wq)246 259 247 260 DO l = 1, n_lev … … 250 263 & F_sed(ig,l+1)*wgt_SA(ig,l+1) 251 264 & - F_sed(ig,l)*wgt_SA(ig,l)) 252 & / m_lay(ig,l) 265 & / m_lay(ig,l) 266 c On peut avoir theoriquement le cas ou on epuise tout le VMR present 267 IF (zqi_sa(ig,l).LT.0.0D0) THEN 268 PRINT*,'STOP sedimentation on epuise tout le VMR present' 269 PRINT*,'couche',ig,'level',l 270 c STOP 271 c Ce n est pas juste mais il faudrait alors adapter les pas 272 c de tps de la phys, microphys et chimie 273 c car dans ce cas, c est comme si on epuisait la couche pour un pdtphys 274 c mais en fait on l epuise pour un pdt<pdtphys 275 zqi_sa(ig,l) = 0.0D0 276 ENDIF 253 277 pdqsed(ig,l,1) = zqi_sa(ig,l) - pq(ig,l,i_h2so4liq) 254 278 ENDDO … … 257 281 c Partie H2Ol 258 282 c ~~~~~~~~~~~ 259 c CALL vlz_fi_par(n_lon,n_lev,zqi_wv,2.,m_lay,F_sed,wq)260 283 261 284 DO l = 1, n_lev … … 265 288 & - F_sed(ig,l)*(1. - wgt_SA(ig,l))) 266 289 & / m_lay(ig,l) 290 c On peut avoir theoriquement le cas ou on epuise tout le VMR present 291 IF (zqi_wv(ig,l).LT.0.0D0) THEN 292 PRINT*,'STOP sedimentation on epuise tout le VMR present' 293 PRINT*,'couche',ig,'level',l 294 c STOP 295 c Ce n est pas juste mais il faudrait alors adapter les pas 296 c de tps de la phys, microphys et chimie 297 c car dans ce cas, c est comme si on epuisait la couche pour un pdtphys 298 c mais en fait on l epuise pour un pdt<pdtphys 299 zqi_wv(ig,l) = 0.0D0 300 ENDIF 267 301 pdqsed(ig,l,2) = zqi_wv(ig,l) - pq(ig,l,i_h2oliq) 268 302 ENDDO 269 303 ENDDO 270 271 304 272 305 c Save output file in 1D model … … 278 311 c DO ig=1,n_lon 279 312 c WRITE(77,"(i4,','11(e15.8,','))") l,pdqsed(ig,l),zqi(ig,l), 280 c & ( wgt_h2so4(ig,l)*pq(ig,l,i_h2so4liq)+281 c & (1.- wgt_h2so4(ig,l))*pq(ig,l,i_h2oliq)),313 c & (WH2SO4(ig,l)*pq(ig,l,i_h2so4liq)+ 314 c & (1.-WH2SO4(ig,l))*pq(ig,l,i_h2oliq)), 282 315 c & pq(ig,l,i_h2so4liq),pq(ig,l,i_h2oliq) 283 316 c ENDDO … … 288 321 END 289 322 323 ******************************************************************************* 324 REAL FUNCTION VISCOSITY_CO2(temp) 325 c Aurélien Stolzenbach 2015 326 c Calcul de la viscosité dynamique du CO2 80°K -> 300°K 327 c Viscosité dynamique en Pa.s 328 c Source: Johnston & Grilly (1942) 329 330 c température en °K 331 REAL, INTENT(IN) :: temp 332 333 REAL :: denom, numer 334 335 c Calcul de la viscosité dynamique grâce à la formule de Jones (Lennard-Jones (1924)) 336 337 numer = 200.**(2.27/4.27)-0.435 338 denom = temp**(2.27/4.27)-0.435 339 340 VISCOSITY_CO2 = (numer/denom)*1015.*(temp/200.)**(3./2.) 341 342 c convertion de Poises*1e7 -> Pa.s 343 VISCOSITY_CO2 = VISCOSITY_CO2*1.e-8 344 345 END FUNCTION VISCOSITY_CO2 346 ******************************************************************************* 347 348 -
trunk/LMDZ.VENUS/libf/phyvenus/new_cloud_venus.F
r1305 r1442 11 11 !* 12 12 !---------------------------------------------------------------------------- 13 SUBROUTINE new_cloud_venus(deltaT,NDTOT, 14 + MEDIAN,GSTDEV,tt, 15 + pp,ppwv, 16 + mr_wv,mr_sa, 17 + niv, 13 SUBROUTINE new_cloud_venus( 14 + nblev, nblon, 15 + TT,PP, 18 16 + mrt_wv,mrt_sa, 19 + WSA, 20 + PSSA,SATPSSA, 21 + RHOSASL) 22 23 24 ! USE real16 17 + mr_wv,mr_sa) 18 25 19 USE chemparam_mod 26 20 IMPLICIT NONE 27 28 ! Niveau (correspond pression, altitude fixe des couches nuageuses) 29 INTEGER niv 30 31 32 ! Aerosol and PSC variables: 33 REAL 34 + WSA,WWV 35 ! REAL RMIN,RMAX 21 22 #include "YOMCST.h" 23 24 INTEGER, INTENT(IN) :: nblon ! nombre de points horizontaux 25 INTEGER, INTENT(IN) :: nblev ! nombre de couches verticales 26 36 27 !---------------------------------------------------------------------------- 37 28 ! Ambient air state variables: 38 REAL 39 + tt,pp, 40 + mr_wv,mr_sa, 41 + PPWV,PPSA, 42 + PSSA,SATPSSA 43 29 REAL, INTENT(IN), DIMENSION(nblon,nblev) :: mrt_wv,mrt_sa, 30 + TT,PP 31 REAL, INTENT(INOUT), DIMENSION(nblon,nblev) :: mr_wv,mr_sa 44 32 !---------------------------------------------------------------------------- 45 ! Physical constants: 46 REAL MH2O,MH2SO4,MAIR,CWV,CSA !,CNA,MHNO3 47 PARAMETER( 48 + MH2O=18.0153d-3, 49 ! + MHNO3=63.01d-3, 50 + MH2SO4=98.078d-3, 51 ! + MAIR=28.9644d-3, 52 !AM Venus 53 + MAIR=43.45d-3, 54 + CWV=MAIR/MH2O, 55 ! + CNA=MAIR/MHNO3, 56 + CSA=MAIR/MH2SO4) 33 INTEGER :: ilon, ilev, imode 34 !---------------------------------------------------------------------------- 57 35 ! Thermodynamic functions: 58 REAL ROSAS 59 !AM 60 ! Mathematical constants: 61 REAL PI 62 PARAMETER(PI=3.1415926536) 63 64 !---------------------------------------------------------------------------- 65 ! Time variables: 66 REAL deltaT 36 REAL :: RHODROPLET 67 37 !---------------------------------------------------------------------------- 68 38 ! Auxilary variables: 69 REAL 70 + NDTOT,MEDIAN,GSTDEV, 71 + mrt_wv,mrt_sa, 72 + NH2SO4,NH2O, 73 + MASS, 74 + X0,X1,X2,X3,X4,X5,X6, 75 + RHOSASL,MSAL, 76 + waterps,condmass,RMH2S4 77 REAL H2SO4,H2SO4_liq,H2O_liq 78 REAL RSTDEV 79 REAL RMEDRA 80 REAL R2SO4 81 REAL DENSO4 82 REAL CONHS4 83 REAL H2O 84 REAL ACTSO4 85 REAL CONCM 86 REAL mrsa_conc 87 REAL RNLOG 88 39 REAL :: NH2SO4,NH2O 40 REAL :: H2SO4_liq,H2O_liq 41 REAL :: CONCM 42 REAL :: MCONDTOT 43 REAL :: RMODE 44 REAL :: WSAFLAG 45 REAL :: K_SAV 46 !---------------------------------------------------------------------------- 47 ! Ridder's Method variables: 48 REAL :: WVMIN, WVMAX, WVACC 49 50 INTEGER :: NBROOT 51 52 INTEGER :: MAXITE 53 PARAMETER(MAXITE=20) 54 55 INTEGER :: NBRAC 56 PARAMETER(NBRAC=20) 57 58 INTEGER :: FLAG 59 !---------------------------------------------------------------------------- 60 61 !---------------------------------------------------------------------------- 62 ! External functions needed: 63 REAL :: IRFRMWV 64 !---------------------------------------------------------------------------- 65 66 89 67 ! >>> Program starts here: 90 68 91 92 ! mass of an H2SO4 molecule (g)93 RMH2S4=98.078/(6.02214129d23)94 95 69 !AM Venus 96 !Here we call a subroutine that contains a nucleation parametrisation for stratosphere and 97 !Venus and use that for calculating the number density of liquid sulfate aerosols. These 98 !aerosols will then be given an equilibrium composition for the given size distribution 99 ! calculates binary nucleation rate using revised theory, stauffer+binder&stauffer kinetics 100 ! and noppel hydrate correction 101 ! t temperature [K] 102 ! rehu relative humidity %/100 which means 100%=1 103 ! rhoa concentration of h2so4 vapour [1/m^3] 104 ! x mole fraction in the core of the critical cluster 105 ! nwtot total number of water molecules in the critical cluster 106 ! natot total number of h2so4 molecules in the critical cluster 107 ! rc radius of the critical cluster core [m] 108 ! jnuc nucleation rate [1/m^3s] 70 ! These aerosols will then be given an equilibrium composition for the given size distribution 109 71 110 72 ! Hanna Vehkamäki and Markku Kulmala and Ismo Napari 111 73 ! and Kari E. J. Lehtinen and Claudia Timmreck and Madis Noppel and Ari Laaksonen, 2002, 112 74 ! An improved parameterization for sulfuric acid/water nucleation rates for tropospheric 113 !and stratospheric conditions, () J. Geophys. Res., 107, pp. 4622-4631 114 75 !and stratospheric conditions, () J. Geophys. Res., 107, PP. 4622-4631 76 77 !=========================================== 78 ! Debut boucle sur niveau et lat,lon 79 !=========================================== 80 ! Init, tous les points=0, cela met les niveaux > cloudmax et < cloudmin a 0 81 NBRTOT(:,:,:)=0.0E+0 82 WH2SO4(:,:)=0.0E+0 83 rho_droplet(:,:)=0.0E+0 84 85 DO ilev=cloudmin, cloudmax 86 DO ilon=1, nblon 87 88 ! Boucle sur les modes 89 RMODE=0.0E+0 90 K_SAV = 0.0 91 92 DO imode=1, nbr_mode 93 IF (K_MASS(ilon,ilev,imode).GT.K_SAV) THEN 94 ! RMODE est le rayon modal de la distribution en volume du mode le plus 95 ! representatif pour la Mtot 96 RMODE=R_MEDIAN(ilon,ilev,imode)* 97 & EXP(2.*(DLOG(STDDEV(ilon,ilev,imode))**2.)) 98 K_SAV=K_MASS(ilon,ilev,imode) 99 ENDIF 100 ENDDO ! FIN boucle imode 101 102 ! Initialisation des bornes pour WV 103 WVMIN=1.E-90 104 WVMAX=mrt_wv(ilon,ilev) 105 106 ! Accuracy de WVeq 107 WVACC=WVMAX*1.0E-3 108 109 ! BRACWV borne la fonction f(WV) - WV = 0 110 ! de WV=0 à WV=WVtot on cherche l'intervalle où f(WV) - WV = 0 111 ! avec précisément f(WVliq de WSA<=WVinput) + WVinput - WVtot = 0 112 ! Elle fait appel à la fct/ssrtine ITERWV() 113 114 CALL BRACWV(WVMIN,WVMAX,NBRAC,RMODE, 115 & mrt_wv(ilon,ilev),mrt_sa(ilon,ilev),TT(ilon,ilev), 116 & PP(ilon,ilev),FLAG,WSAFLAG,NBROOT) 117 118 SELECT CASE(FLAG) 119 120 CASE(1) 121 ! Cas NROOT=1 ou NROOT>1 mais dans un intervalle restreint WVTOT (cas courant) 122 ! IRFRMWV Ridder's method pour trouver, sur [WVmin,WVmax], WVo tel que f(WVo) - WVo = 0 123 ! Elle fait appel la fct/ssrtine ITERWV() 124 125 WH2SO4(ilon,ilev)=IRFRMWV(WVMIN,WVMAX,WVACC,MAXITE,RMODE, 126 & TT(ilon,ilev),PP(ilon,ilev), 127 & mrt_wv(ilon,ilev),mrt_sa(ilon,ilev),NBROOT) 128 129 rho_droplet(ilon,ilev)=RHODROPLET(WH2SO4(ilon,ilev), 130 & TT(ilon,ilev)) 131 132 ! IF (rho_droplet(ilon,ilev).LT.1100.) THEN 133 ! PRINT*,'PROBLEM RHO_DROPLET' 134 ! PRINT*,'rho_droplet',rho_droplet(ilon,ilev) 135 ! PRINT*,'T',TT(ilon,ilev),'WSA',WH2SO4(ilon,ilev) 136 ! PRINT*,'RHODROPLET',RHODROPLET(WH2SO4(ilon,ilev), 137 ! & TT(ilon,ilev)) 138 ! PRINT*,'FLAG',FLAG,'NROOT',NBROOT 139 ! STOP 140 ! ENDIF 141 142 CONCM= PP(ilon,ilev)/(1.3806488E-23*TT(ilon,ilev)) !air number density, molec/m3 143 144 NH2SO4=mrt_sa(ilon,ilev)*CONCM 145 NH2O=mrt_wv(ilon,ilev)*CONCM 146 147 CALL CALCM_SAT(NH2SO4,NH2O,WH2SO4(ilon,ilev), 148 & rho_droplet(ilon,ilev),TT(ilon,ilev), 149 & H2SO4_liq,H2O_liq,MCONDTOT) 150 151 ! Boucle sur les modes 152 DO imode=1, nbr_mode 153 IF (K_MASS(ilon,ilev,imode).GT.0.) THEN 154 NBRTOT(ilon,ilev,imode)= 1.E-6*3./(4.*RPI)* 155 & K_MASS(ilon,ilev,imode)*MCONDTOT* 156 & EXP(-4.5*DLOG(STDDEV(ilon,ilev,imode))**2.)/ 157 & (R_MEDIAN(ilon,ilev,imode)**3.) 158 ELSE 159 NBRTOT(ilon,ilev,imode)=0.0E+0 160 ENDIF 161 ENDDO 162 163 ! Passage de #/m3 en VMR 164 H2O_liq=H2O_liq/CONCM 165 H2SO4_liq=H2SO4_liq/CONCM 166 167 mr_wv(ilon,ilev)=mrt_wv(ilon,ilev)-H2O_liq 168 mr_sa(ilon,ilev)=mrt_sa(ilon,ilev)-H2SO4_liq 169 170 ! Problemes quand on a condense tout, on peut obtenir des -1e-24 171 ! aprs la soustraction et conversion de ND VMR 172 IF (mr_wv(ilon,ilev).LE.0.0) mr_wv(ilon,ilev)=1.0E-30 173 IF (mr_sa(ilon,ilev).LE.0.0) mr_sa(ilon,ilev)=1.0E-30 174 175 176 177 CASE(2) 178 ! Cas NROOT=0 mais proche de 0 179 180 WH2SO4(ilon,ilev)=WSAFLAG 181 182 rho_droplet(ilon,ilev)=RHODROPLET(WH2SO4(ilon,ilev), 183 & TT(ilon,ilev)) 184 185 ! ATTENTION ce IF ne sert a rien en fait, juste a retenir une situation 186 ! ubuesque dans mon code ou sans ce IF les valeurs de rho_droplets sont 187 ! incohrentes avec TT et WH2SO4 (a priori lorsque NTOT=0) 188 ! Juste le fait de METTRE un IF fait que rho_droplet a la bonne valeur 189 ! donne par RHODROPLET (cf test externe en Python), sinon, la valeur est trop 190 ! basse (de l'ordre de 1000 kg/m3) et correspond parfois la valeur avec 191 ! WSA=0.1 (pas totalement sur) 192 ! En tous cas, incoherent avec ce qui est attendue pour le WSA et T donnee 193 ! La version avec le IF (rho<1100 & WSA>0.1) est CORRECTE, rho_droplet a 194 ! la bonne valeur (tests externes Python confirment) 195 196 IF ((rho_droplet(ilon,ilev).LT.1100.).AND. 197 & (WH2SO4(ilon,ilev).GT.0.1))THEN 198 PRINT*,'PROBLEM RHO_DROPLET' 199 PRINT*,'rho_droplet',rho_droplet(ilon,ilev) 200 PRINT*,'T',TT(ilon,ilev),'WSA',WH2SO4(ilon,ilev) 201 PRINT*,'RHODROPLET',RHODROPLET(WH2SO4(ilon,ilev), 202 & TT(ilon,ilev)) 203 PRINT*,'FLAG',FLAG,'NROOT',NBROOT 204 STOP 205 ENDIF 115 206 116 IF (niv.GE.cloudmin .AND. niv.LE.cloudmax) THEN117 118 CALL WGTGV(MEDIAN,TT,PPWV,WSA,RHOSASL,MSAL)119 120 R2SO4=WSA*100.121 ! R2SO4 -> activity coeff (ACTSO4)122 CALL STRAACT(R2SO4,ACTSO4)123 ! write(*,*) 'R2SO4,ACTSO4 ',R2SO4,ACTSO4124 ! R2SO4, T -> aerosol density (R2SO4)125 126 DENSO4=ROSAS(TT,WSA)127 ! units g/cm3 required by the following routines128 DENSO4=DENSO4*1.d-3129 130 CONCM= (PP)/(1.3806488D-23*TT) !air number density, molec/m3? CHECK UNITS!131 CONCM=CONCM*1.d-6 !in molec./cm3132 133 NH2SO4=mrt_sa*CONCM134 NH2O=mrt_wv*CONCM135 136 CALL CALNLOG_SAT(ACTSO4,NH2SO4,NH2O,WSA,DENSO4,GSTDEV,137 + MEDIAN,TT,RNLOG,H2SO4_liq,H2O_liq,138 + PSSA,SATPSSA)139 140 141 ! NDTOT nbr # pour 1cm3142 NDTOT=RNLOG143 144 ! IF ((NDTOT.GT.1.0d+3).OR.145 ! & ((niv.GT.45).AND.(mr_wv.GT.1.0e-6))) THEN146 ! PRINT*,'PROBLEME GENERAL AVEC CES PUTAINS DE ROUTINES'147 ! PRINT*,'H2SO4COND',H2SO4_liq/CONCM,'H2SO4',mr_sa148 ! PRINT*,'DND2',SATPSSA*1.0d-6/(1.38D-23*TT)149 ! PRINT*,'NH2O',NH2O,'NH2SO4',NH2SO4150 ! PRINT*,'H2OCOND',H2O_liq/CONCM,'H2O',mr_wv151 ! PRINT*,'H2SO4tot',mrt_sa,'H2Otot',mrt_wv152 ! PRINT*,'MEDIAN',MEDIAN,'GSTDEV',GSTDEV153 ! PRINT*,'NBRTOT',NDTOT,'level',niv,'WSA',WSA154 ! STOP155 ! ENDIF156 157 158 mr_wv=mrt_wv-H2O_liq/CONCM159 mr_sa=mrt_sa-H2SO4_liq/CONCM160 207 161 208 CONCM= PP(ilon,ilev)/(1.3806488E-23*TT(ilon,ilev)) !air number density, molec/m3 209 210 NH2SO4=mrt_sa(ilon,ilev)*CONCM 211 NH2O=mrt_wv(ilon,ilev)*CONCM 212 213 CALL CALCM_SAT(NH2SO4,NH2O,WH2SO4(ilon,ilev), 214 & rho_droplet(ilon,ilev),TT(ilon,ilev), 215 & H2SO4_liq,H2O_liq,MCONDTOT) 216 217 ! Boucle sur les modes 218 DO imode=1, nbr_mode 219 IF (K_MASS(ilon,ilev,imode).GT.0.) THEN 220 NBRTOT(ilon,ilev,imode)= 1.E-6*3./(4.*RPI)* 221 & K_MASS(ilon,ilev,imode)*MCONDTOT* 222 & EXP(-4.5*DLOG(STDDEV(ilon,ilev,imode))**2.)/ 223 & (R_MEDIAN(ilon,ilev,imode)**3.) 224 ELSE 225 NBRTOT(ilon,ilev,imode)=0.0E+0 226 ENDIF 227 ENDDO 228 229 ! Passage de #/m3 en VMR 230 H2O_liq=H2O_liq/CONCM 231 H2SO4_liq=H2SO4_liq/CONCM 232 233 mr_wv(ilon,ilev)=mrt_wv(ilon,ilev)-H2O_liq 234 mr_sa(ilon,ilev)=mrt_sa(ilon,ilev)-H2SO4_liq 235 162 236 ! Problmes quand on a condense tout, on peut obtenir des -1e-24 163 237 ! aprs la soustraction et conversion de ND VMR 164 IF (mr_wv.LT.0.0) THEN 165 mr_wv=0.0d0 166 END IF 238 IF (mr_wv(ilon,ilev).LE.0.0) mr_wv(ilon,ilev)=1.0E-30 239 IF (mr_sa(ilon,ilev).LE.0.0) mr_sa(ilon,ilev)=1.0E-30 167 240 168 IF (mr_sa.LT.0.0) THEN 169 mr_sa=0.0d0 170 END IF 241 CASE(3) 242 ! Cas 0 NROOT 243 mr_wv(ilon,ilev)=mrt_wv(ilon,ilev) 244 mr_sa(ilon,ilev)=mrt_sa(ilon,ilev) 245 rho_droplet(ilon,ilev)=0.0E+0 246 WH2SO4(ilon,ilev)=0.0E+0 247 DO imode=1, nbr_mode 248 NBRTOT(ilon,ilev,imode)=0.0E+0 249 ENDDO 250 251 END SELECT 252 ENDDO !FIN boucle ilon 253 ENDDO !FIN boucle ilev 254 255 END SUBROUTINE new_cloud_venus 256 257 258 !***************************************************************************** 259 !* SUBROUTINE ITERWV() 260 SUBROUTINE ITERWV(WV,WVLIQ,WVEQOUT,WVTOT,WSAOUT,SATOT, 261 + TAIR,PAIR,RADIUS) 262 !***************************************************************************** 263 !* Cette routine est la solution par itration afin de trouver WSA pour un WV, 264 !* et donc LPPWV, donn. Ce qui nous donne egalement le WV correspondant au 265 !* WSA solution 266 !* For VenusGCM by A. Stolzenbach 07/2014 267 !* OUTPUT: WVEQ et WSAOUT 268 269 IMPLICIT NONE 270 REAL, INTENT(IN) :: WV, WVTOT, SATOT, TAIR, PAIR, RADIUS 271 272 REAl, INTENT(OUT) :: WVEQOUT, WSAOUT, WVLIQ 273 274 REAL :: WSAMIN, WSAMAX, WSAACC 275 PARAMETER(WSAACC=0.001) 276 277 REAL :: LPPWV 278 279 INTEGER :: MAXITSA, NBRACSA, NBROOT 280 PARAMETER(MAXITSA=20) 281 PARAMETER(NBRACSA=20) 282 283 LOGICAl :: FLAG1,FLAG2 284 285 ! External Function 286 REAl :: IRFRMSA, WVCOND 287 288 IF (RADIUS.LT.1E-30) THEN 289 PRINT*,'RMODE == 0 FLAG 3' 290 STOP 291 ENDIF 292 ! Initialisation WSA=[0.1,1.0] 293 WSAMIN=0.1 294 WSAMAX=1.0 295 296 LPPWV=DLOG(PAIR*WV) 297 298 ! Appel Bracket de KEEQ 299 CALL BRACWSA(WSAMIN,WSAMAX,NBRACSA,RADIUS,TAIR, 300 & LPPWV,FLAG1,FLAG2,NBROOT) 301 302 IF ((.NOT.FLAG1).AND.(.NOT.FLAG2).AND.(NBROOT.EQ.1)) THEN 303 ! Appel Ridder's Method 304 305 WSAOUT=IRFRMSA(WSAMIN,WSAMAX,WSAACC,MAXITSA, 306 & RADIUS,TAIR,PAIR,LPPWV,NBROOT) 307 ! IF (WSAOUT.EQ.1.0) WSAOUT=0.999999 308 ! IF (WSAOUT.LT.0.1) WSAOUT=0.1 309 310 ! Si BRACWSA ne trouve aucun ensemble solution KEEQ=0 on fixe WSA a 0.9999 ou 0.1 311 ELSE 312 IF (FLAG1.AND.(.NOT.FLAG2)) WSAOUT=0.999999 313 IF (FLAG2.AND.(.NOT.FLAG1)) WSAOUT=WSAMIN 314 IF (FLAG1.AND.FLAG2) THEN 315 PRINT*,'FLAGs BARCWSA tous TRUE' 316 STOP 317 ENDIF 318 ENDIF 319 320 321 ! WVEQ output correspondant a WVliq lie a WSA calcule 322 WVLIQ=WVCOND(WSAOUT,TAIR,PAIR,SATOT) 323 WVEQOUT=(WVLIQ+WV)/WVTOT-1.0 324 325 END SUBROUTINE ITERWV 326 327 328 !***************************************************************************** 329 !* SUBROUTINE BRACWV() 330 SUBROUTINE BRACWV(XA,XB,N,RADIUS,WVTOT,SATOT,TAIR,PAIR, 331 + FLAGWV,WSAFLAG,NROOT) 332 !***************************************************************************** 333 !* Bracket de ITERWV 334 !* From Numerical Recipes 335 !* Adapted for VenusGCM A. Stolzenbach 07/2014 336 !* X est WVinput 337 !* OUTPUT: XA et XB 338 339 IMPLICIT NONE 340 341 REAL, INTENT(IN) :: WVTOT,SATOT,RADIUS,TAIR,PAIR 342 INTEGER, INTENT(IN) :: N 343 344 REAL, INTENT(INOUT) :: XA,XB 345 REAL, INTENT(OUT) :: WSAFLAG 346 347 INTEGER :: I,J 348 349 INTEGER, INTENT(OUT) :: NROOT 350 351 REAL :: FP, FC, X, WVEQ, WVLIQ, WSAOUT 352 REAL :: XMAX,XMIN,WVEQACC 353 354 INTEGER, INTENT(OUT) :: FLAGWV 355 356 ! WVEQACC est le seuil auquel on accorde un WSA correct meme 357 ! si il ne fait pas partie d'une borne. Utile quand le modele 358 ! s'approche de 0 mais ne l'atteint pas. 359 WVEQACC=1.0E-3 360 361 FLAGWV=1 362 363 NROOT=0 364 365 X=XA 366 XMAX=XB 367 XMIN=XA 368 369 ! CAS 1 On borne la fonction (WVEQ=0) 370 371 CALL ITERWV(X,WVLIQ,WVEQ,WVTOT,WSAOUT,SATOT,TAIR,PAIR,RADIUS) 372 FP=WVEQ 373 374 DO I=1,N-1 375 X=(1.-DLOG(REAL(N-I))/DLOG(REAL(N)))*XMAX 376 CALL ITERWV(X,WVLIQ,WVEQ,WVTOT,WSAOUT,SATOT,TAIR,PAIR,RADIUS) 377 FC=WVEQ 378 379 IF ((FP*FC).LT.0.0) THEN 380 NROOT=NROOT+1 381 ! Si NROOT>1 on place la borne sup output la borne min du calcul en i 382 IF (NROOT.GT.1) THEN 383 XB=(1.-DLOG(REAL(N-I+1))/DLOG(REAL(N)))*XMAX 384 ENDIF 385 386 IF (I.EQ.1) THEN 387 XA=XMIN 388 ELSE 389 XA=(1.-DLOG(REAL(N-I+1))/DLOG(REAL(N)))*XMAX 390 ENDIF 391 XB=X 392 ENDIF 393 FP=FC 394 ENDDO 395 396 ! CAS 2 on refait la boucle pour tester si WVEQ est proche de 0 397 ! avec le seuil WVEQACC 398 IF (NROOT.EQ.0) THEN 399 X=XMIN 400 CALL ITERWV(X,WVLIQ,WVEQ,WVTOT,WSAOUT,SATOT, 401 + TAIR,PAIR,RADIUS) 402 DO J=1,N-1 403 X=(1.-DLOG(REAL(N-J))/DLOG(REAL(N)))*XMAX 404 CALL ITERWV(X,WVLIQ,WVEQ,WVTOT,WSAOUT,SATOT, 405 + TAIR,PAIR,RADIUS) 406 407 IF (ABS(WVEQ).LE.WVEQACC) THEN 408 WSAFLAG=WSAOUT 409 FLAGWV=2 410 RETURN 411 ENDIF 412 ENDDO 413 414 ! CAS 3 Pas de borne, WVEQ jamais proche de 0 415 FLAGWV=3 416 RETURN 417 ENDIF 418 419 END SUBROUTINE BRACWV 420 421 !***************************************************************************** 422 !* SUBROUTINE BRACWSA() 423 SUBROUTINE BRACWSA(XA,XB,N,RADIUS,TAIR,LPPWVINP,FLAGH,FLAGL, 424 + NROOT) 425 !***************************************************************************** 426 !* Bracket de KEEQ 427 !* From Numerical Recipes 428 !* Adapted for VenusGCM A. Stolzenbach 07/2014 429 430 IMPLICIT NONE 431 432 !---------------------------------------------------------------------------- 433 ! External functions needed: 434 REAl KEEQ 435 !---------------------------------------------------------------------------- 436 437 REAL, INTENT(IN) :: RADIUS,TAIR,LPPWVINP 438 INTEGER, INTENT(IN) :: N 439 440 REAL, INTENT(INOUT) :: XA,XB 441 442 INTEGER, INTENT(OUT) :: NROOT 443 444 INTEGER :: I, J 445 446 REAL :: DX, FP, FC, X 447 448 LOGICAL, INTENT(OUT) :: FLAGH,FLAGL 449 450 451 FLAGL=.FALSE. 452 FLAGH=.FALSE. 453 NROOT=0 454 DX=(XB-XA)/N 455 X=XA 456 FP=KEEQ(RADIUS,TAIR,X,LPPWVINP) 457 458 DO I=1,N 459 X=X+DX 460 FC=KEEQ(RADIUS,TAIR,X,LPPWVINP) 461 462 IF ((FP*FC).LE.0.) THEN 463 NROOT=NROOT+1 464 XA=X-DX 465 XB=X 466 ! RETURN 467 ! IF (NROOT.GT.1) THEN 468 ! PRINT*,'On a plus d1 intervalle KEEQ=0' 469 ! PRINT*,'Probleme KEEQ=0 => 1 racine en theorie' 470 ! X=X-(I*DX) 471 ! FP=KEEQ(RADIUS,TAIR,X,LPPWVINP) 472 ! PRINT*,'KEEQ(WSA)',FP,X,TAIR 473 ! DO J=1,N 474 ! X=X+DX 475 ! FP=KEEQ(RADIUS,TAIR,X,LPPWVINP) 476 ! PRINT*,'KEEQ(WSA)',FP,X 477 ! ENDDO 478 ! STOP 479 ! ENDIF 480 ENDIF 481 482 FP=FC 483 ENDDO 484 485 IF (NROOT.EQ.0) THEN 486 ! PRINT*,'On a 0 intervalle KEEQ=0' 487 ! PRINT*,'Probleme KEEQ=0 => 1 racine en theorie' 488 ! PRINT*,'XA',XA,'KEEQ',KEEQ(RADIUS,TAIR,XA,LPPWVINP) 489 ! PRINT*,'XB',XB,'KEEQ',KEEQ(RADIUS,TAIR,XB,LPPWVINP) 490 ! PRINT*,'TT',TAIR 491 ! PRINT*,'RADIUS',RADIUS 492 ! PRINT*,'NBRAC',N 493 ! STOP 494 495 ! X=XA 496 ! FP=KEEQ(RADIUS,TAIR,X,LPPWVINP) 497 ! PRINT*,'KEEQ(WSA)',FP,X,TAIR 498 ! DO I=1,N 499 ! X=X+DX 500 ! FP=KEEQ(RADIUS,TAIR,X,LPPWVINP) 501 ! PRINT*,'KEEQ(WSA)',FP,X,TAIR 502 ! ENDDO 503 504 505 ! Test determine la tendance globale KEEQ sur [WSAMIN,WSAMAX] 506 IF ((ABS(KEEQ(RADIUS,TAIR,XA,LPPWVINP))- 507 & ABS(KEEQ(RADIUS,TAIR,XB,LPPWVINP))).GT.0.0) FLAGH=.TRUE. 508 ! On fixe flag low TRUE pour WSA = 0.1 509 IF ((ABS(KEEQ(RADIUS,TAIR,XA,LPPWVINP))- 510 & ABS(KEEQ(RADIUS,TAIR,XB,LPPWVINP))).LT.0.0) FLAGL=.TRUE. 511 ! STOP 512 ENDIF 513 514 END SUBROUTINE BRACWSA 515 516 517 !***************************************************************************** 518 !* REAL FUNCTION WVCOND() 519 REAL FUNCTION WVCOND(WSA,T,P,SAt) 520 !***************************************************************************** 521 !* Condensation de H2O selon WSA, T et P et H2SO4tot 522 !* 523 !* Adapted for VenusGCM A. Stolzenbach 07/2014 524 ! INPUT: 525 ! SAt : VMR of total H2SO4 526 ! WSA: aerosol H2SO4 weight fraction (fraction) 527 ! T: temperature (K) 528 ! P: pressure (Pa) 529 ! OUTPUT: 530 ! WVCOND : VMR H2O condense 531 532 ! USE chemparam_mod 533 534 IMPLICIT NONE 535 536 REAL, INTENT(IN) :: SAt, WSA 537 REAL, INTENT(IN) :: T, P 538 539 ! working variables 540 REAL SA, WV 541 REAL DND2,pstand,lpar,acidps 542 REAL x1, satpacid 543 REAL , DIMENSION(2):: act 544 REAL CONCM 545 REAL NH2SO4 546 REAL H2OCOND, H2SO4COND 547 548 549 CONCM= (P)/(1.3806488E-23*T) !air number density, molec/m3? CHECK UNITS! 550 551 NH2SO4=SAt*CONCM 552 553 pstand=1.01325E+5 !Pa 1 atm pressure 554 555 x1=(WSA/98.08)/(WSA/98.08 + ((1.-WSA)/18.0153)) 556 557 CALL zeleznik(x1,T,act) 558 559 !pure acid satur vapor pressure 560 lpar= -11.695+DLOG(pstand) ! Zeleznik 561 acidps=1/360.15-1.0/T+0.38/545. 562 & *(1.0+DLOG(360.15/T)-360.15/T) 563 acidps = 10156.0*acidps +lpar 564 acidps = DEXP(acidps) !Pa 565 566 !acid sat.vap.PP over mixture (flat surface): 567 satpacid=act(2)*acidps ! Pa 568 569 ! Conversion from Pa to N.D #/m3 570 DND2=satpacid/(1.3806488E-23*T) 571 572 ! H2SO4COND N.D #/m3 condensee ssi H2SO4>H2SO4sat 573 IF (NH2SO4.GT.DND2) THEN 574 H2SO4COND=NH2SO4-DND2 575 ! calcul de H2O cond correspondant a H2SO4 cond 576 H2OCOND=H2SO4COND*98.078*(1.0-WSA)/(18.0153*WSA) 577 578 ! Si on a H2SO4<H2SO4sat on ne condense rien, VMR = 1.0E-30 579 ELSE 580 H2OCOND=1.0E-30*CONCM 581 END IF 582 583 !***************************************************** 584 ! ATTENTION: Ici on ne prends pas en compte 585 ! si H2O en defaut! 586 ! On veut la situation theorique 587 ! a l'equilibre 588 !***************************************************** 589 ! Test si H2O en defaut H2Ocond>H2O dispo 590 ! IF ((H2OCOND.GT.NH2O).AND.(NH2SO4.GE.DND2)) THEN 171 591 172 173 ELSE 174 ! PRINT*,'**** NDTOT OUT CLOUD ****' 175 NDTOT=0.0d0 176 WSA=0.0d0 177 PSSA=0.0d0 178 SATPSSA=0.0d0 179 RHOSASL=0.0d0 180 ! write(*,*) 'NDTOT = 0.0!!' 181 END IF 592 ! On peut alors condenser tout le H2O dispo 593 ! H2OCOND=NH2O 594 ! On met alors egalement a jour le H2SO4 cond correspondant au H2O cond 595 ! H2SO4COND=H2OCOND*18.0153*WSA/(98.078*(1.0-WSA)) 596 597 ! END IF 598 599 ! Calcul de H2O condense VMR 600 WVCOND=H2OCOND/CONCM 601 602 END FUNCTION WVCOND 603 604 !***************************************************************************** 605 !* REAL FUNCTION IRFRMWV() 606 REAL FUNCTION IRFRMWV(X1,X2,XACC,MAXIT,RADIUS,TAIR,PAIR, 607 + WVTOT,SATOT,NROOT) 608 !***************************************************************************** 609 !* Iterative Root Finder Ridder's Method for Water Vapor calculus 610 !* From Numerical Recipes 611 !* Adapted for VenusGCM A. Stolzenbach 07/2014 612 !* 613 !* Les iterations sur [X1,X2] sont [WV1,WV2] 614 !* la variable X est WV 615 !* IRFRMWV sort en OUTPUT : WSALOC pour ITERWV=0 (ou WVEQ=0) 616 617 IMPLICIT NONE 618 619 REAL, INTENT(IN) :: X1, X2 620 REAL, INTENT(IN) :: XACC 621 INTEGER, INTENT(IN) :: MAXIT,NROOT 622 623 ! LOCAL VARIABLES 624 REAL :: XL, XH, XM, XNEW, X 625 REAL :: WSALOC, WVEQ, WVLIQ 626 REAL :: FL, FH, FM, FNEW 627 REAL :: ANS, S, FSIGN 628 INTEGER i 629 630 ! External variables needed: 631 REAL, INTENT(IN) :: TAIR,PAIR 632 REAL, INTENT(IN) :: WVTOT,SATOT 633 REAL, INTENT(IN) :: RADIUS 634 635 636 ! Initialisation 637 X=X1 638 CALL ITERWV(X,WVLIQ,WVEQ,WVTOT,WSALOC,SATOT,TAIR,PAIR,RADIUS) 639 FL=WVEQ 640 X=X2 641 CALL ITERWV(X,WVLIQ,WVEQ,WVTOT,WSALOC,SATOT,TAIR,PAIR,RADIUS) 642 FH=WVEQ 643 644 ! Test Bracketed values 645 IF (((FL.LT.0.).AND.(FH.GT.0.)).OR. 646 & ((FL.GT.0.).AND.(FH.LT.0.))) 647 & THEN 648 XL=X1 649 XH=X2 650 ANS=-9.99e99 651 652 DO i=1, MAXIT 653 XM=0.5*(XL+XH) 654 CALL ITERWV(XM,WVLIQ,WVEQ,WVTOT,WSALOC,SATOT, 655 & TAIR,PAIR,RADIUS) 656 FM=WVEQ 657 S=SQRT(FM*FM-FL*FH) 658 659 IF (S.EQ.0.0) THEN 660 IRFRMWV=WSALOC 661 RETURN 662 ENDIF 182 663 183 END 184 185 186 ****************************************************************************** 187 * SUBROUTINE WGTGV(RADIUS,TAIR,PPWV,WSAS,RHOSAS,MSA) 188 ****************************************************************************** 189 * 190 * This subroutine calculates the acid mass fraction, density, and 191 * mass of sulfuric acid in a single aerosol droplet of a specified 192 * radius in equilibrium with ambient water vapor partial pressure 193 * and temperature. 194 * 195 * The calculation is performed by iteration of 196 * ln(PPWV) - [(2Mh2o sigma)/(R T r rho) - ln(ph2osa)] = 0 197 * using the secant method. Vapor pressures by Gmitro and Vermeulen 198 * (PWVSAS_GV) are used. 199 * 200 * Input/output variables: 201 * REAL(KIND=4) RADIUS,TAIR,PPWV,WSAS,RHOSAS,MSA 202 * 203 * Input: 204 * RADIUS: m Radius of aerosol droplet 205 * TAIR: K Temperature of ambient air 206 * PPWV: Pa Partial pressure of ambient water vapor 207 * 208 * Output: 209 * WSAS: mass fraction of sulfuric acid. [0.1;1] 210 * RHOSAS: kg/m**3 Density of sulfuric acid solution droplet 211 * MSA: kg Mass of sulfuric acid in droplet 212 * CALL WGTGV(PTSIZE(25,1),TAIR,PPPWV,WSA,MSA1) 213 SUBROUTINE WGTGV(RADIUS,TAIR,PPWV,WSAS,RHOSAS,MSA) 214 ! 215 ! USE real16 664 IF (FL.GT.FH) THEN 665 FSIGN=1.0 666 ELSE 667 FSIGN=-1.0 668 ENDIF 669 670 XNEW=XM+(XM-XL)*(FSIGN*FM/S) 671 672 IF (ABS(XNEW-ANS).LE.XACC) THEN 673 IRFRMWV=WSALOC 674 RETURN 675 ENDIF 676 677 ANS=XNEW 678 CALL ITERWV(ANS,WVLIQ,WVEQ,WVTOT,WSALOC,SATOT, 679 & TAIR,PAIR,RADIUS) 680 FNEW=WVEQ 681 682 IF (FNEW.EQ.0.0) THEN 683 IRFRMWV=WSALOC 684 RETURN 685 ENDIF 686 687 IF (SIGN(FM, FNEW).NE.FM) THEN 688 XL=XM 689 FL=FM 690 XH=ANS 691 FH=FNEW 692 ELSEIF (SIGN(FL, FNEW).NE.FL) THEN 693 XH=ANS 694 FH=FNEW 695 ELSEIF (SIGN(FH, FNEW).NE.FH) THEN 696 XL=ANS 697 FL=FNEW 698 ELSE 699 PRINT*,'PROBLEM IRFRMWV dans new_cloud_venus' 700 PRINT*,'you shall not PAAAAAASS' 701 STOP 702 ENDIF 703 ENDDO 704 PRINT*,'Paaaaas bien MAXIT atteint' 705 PRINT*,'PROBLEM IRFRMWV dans new_cloud_venus' 706 PRINT*,'you shall not PAAAAAASS' 707 XL=X1 708 XH=X2 709 ANS=-9.99e99 710 711 DO i=1, MAXIT 712 XM=0.5*(XL+XH) 713 CALL ITERWV(XM,WVLIQ,WVEQ,WVTOT,WSALOC,SATOT, 714 & TAIR,PAIR,RADIUS) 715 FM=WVEQ 716 S=SQRT(FM*FM-FL*FH) 717 IF (FL.GT.FH) THEN 718 FSIGN=1.0 719 ELSE 720 FSIGN=-1.0 721 ENDIF 722 723 XNEW=XM+(XM-XL)*(FSIGN*FM/S) 724 725 ANS=XNEW 726 CALL ITERWV(ANS,WVLIQ,WVEQ,WVTOT,WSALOC,SATOT, 727 & TAIR,PAIR,RADIUS) 728 FNEW=WVEQ 729 PRINT*,'WVliq',WVLIQ,'WVtot',WVTOT,'WVeq',WVEQ 730 PRINT*,'WSA',WSALOC,'SAtot',SATOT 731 PRINT*,'T',TAIR,'P',PAIR 732 733 IF (SIGN(FM, FNEW).NE.FM) THEN 734 XL=XM 735 FL=FM 736 XH=ANS 737 FH=FNEW 738 ELSEIF (SIGN(FL, FNEW).NE.FL) THEN 739 XH=ANS 740 FH=FNEW 741 ELSEIF (SIGN(FH, FNEW).NE.FH) THEN 742 XL=ANS 743 FL=FNEW 744 ELSE 745 PRINT*,'PROBLEM IRFRMWV dans new_cloud_venus' 746 PRINT*,'you shall not PAAAAAASS TWIIICE???' 747 STOP 748 ENDIF 749 ENDDO 750 STOP 751 ELSE 752 PRINT*,'IRFRMWV must be bracketed' 753 PRINT*,'NROOT de BRACWV', NROOT 754 IF (ABS(FL).LT.XACC) THEN 755 PRINT*,'IRFRMWV FL == 0',FL 756 PRINT*,'X1',X1,'X2',X2,'FH',FH 757 CALL ITERWV(X1,WVLIQ,WVEQ,WVTOT,WSALOC,SATOT, 758 & TAIR,PAIR,RADIUS) 759 IRFRMWV=WSALOC 760 RETURN 761 ENDIF 762 IF (ABS(FH).LT.XACC) THEN 763 PRINT*,'IRFRMWV FH == 0',FH 764 PRINT*,'X1',X1,'X2',X2,'FL',FL 765 CALL ITERWV(X2,WVLIQ,WVEQ,WVTOT,WSALOC,SATOT, 766 & TAIR,PAIR,RADIUS) 767 IRFRMWV=WSALOC 768 RETURN 769 ENDIF 770 IF ((ABS(FL).GT.XACC).AND.(ABS(FH).GT.XACC)) THEN 771 PRINT*,'STOP dans IRFRMWV avec rien == 0' 772 PRINT*,'X1',X1,'X2',X2 773 PRINT*,'Fcalc',FL,FH 774 PRINT*,'T',TAIR,'P',PAIR,'R',RADIUS 775 STOP 776 ENDIF 777 IF ((ABS(FL).LT.XACC).AND.(ABS(FH).LT.XACC)) THEN 778 PRINT*,'STOP dans IRFRMWV Trop de solution < WVACC' 779 PRINT*,FL,FH 780 STOP 781 ENDIF 782 783 784 ENDIF 785 ! FIN Test Bracketed values 786 787 END FUNCTION IRFRMWV 788 789 !***************************************************************************** 790 !* REAL FUNCTION IRFRMSA() 791 REAL FUNCTION IRFRMSA(X1,X2,XACC,MAXIT,RADIUS,TAIR,PAIR,LPPWV, 792 + NB) 793 !***************************************************************************** 794 !* Iterative Root Finder Ridder's Method for Sulfuric Acid calculus 795 !* From Numerical Recipes 796 !* Adapted for VenusGCM A. Stolzenbach 07/2014 797 !* 798 !* Les iterations sur [X1,X2] sont [WSA1,WSA2] 799 !* la variable X est WSA 800 !* IRFRMSA sort en OUTPUT : WSA pour KEEQ=0 801 216 802 IMPLICIT NONE 217 ! integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL 218 ! integer, parameter :: real_8 = selected_real_kind(2*precision 219 ! + (1.0_sp_k)) 220 221 REAL RADIUS,TAIR,PPWV,WSAS,RHOSAS,MSA 222 ! 803 804 REAL, INTENT(IN) :: X1, X2 805 REAL, INTENT(IN) :: XACC 806 INTEGER, INTENT(IN) :: MAXIT, NB 807 808 ! LOCAL VARIABLES 809 REAL XL, XH, XM, XNEW 810 REAL Fl, FH, FM, FNEW 811 REAL ANS, S, FSIGN 812 INTEGER i 813 814 ! External variables needed: 815 REAL, INTENT(IN) :: TAIR,PAIR 816 REAL, INTENT(IN) :: LPPWV 817 REAL, INTENT(IN) :: RADIUS 818 819 ! External functions needed: 820 REAL KEEQ 821 822 823 824 ! Initialisation 825 FL=KEEQ(RADIUS,TAIR,X1,LPPWV) 826 FH=KEEQ(RADIUS,TAIR,X2,LPPWV) 827 828 ! Test Bracketed values 829 IF (((FL.LT.0.).AND.(FH.GT.0.)).OR.((FL.GT.0.).AND.(FH.LT.0.))) 830 & THEN 831 XL=X1 832 XH=X2 833 ANS=-9.99e99 834 835 DO i=1, MAXIT 836 XM=0.5*(XL+XH) 837 FM=KEEQ(RADIUS,TAIR,XM,LPPWV) 838 S=SQRT(FM*FM-FL*FH) 839 840 IF (S.EQ.0.0) THEN 841 IRFRMSA=ANS 842 RETURN 843 ENDIF 844 845 IF (FL.GT.FH) THEN 846 FSIGN=1.0 847 ELSE 848 FSIGN=-1.0 849 ENDIF 850 851 XNEW=XM+(XM-XL)*(FSIGN*FM/S) 852 853 IF (ABS(XNEW-ANS).LE.XACC) THEN 854 IRFRMSA=ANS 855 RETURN 856 ENDIF 857 858 ANS=XNEW 859 FNEW=KEEQ(RADIUS,TAIR,ANS,LPPWV) 860 861 IF (FNEW.EQ.0.0) THEN 862 IRFRMSA=ANS 863 RETURN 864 ENDIF 865 866 IF (SIGN(FM, FNEW).NE.FM) THEN 867 XL=XM 868 FL=FM 869 XH=ANS 870 FH=FNEW 871 ELSEIF (SIGN(FL, FNEW).NE.FL) THEN 872 XH=ANS 873 FH=FNEW 874 ELSEIF (SIGN(FH, FNEW).NE.FH) THEN 875 XL=ANS 876 FL=FNEW 877 ELSE 878 PRINT*,'PROBLEM IRFRMSA dans new_cloud_venus' 879 PRINT*,'you shall not PAAAAAASS' 880 STOP 881 ENDIF 882 ENDDO 883 PRINT*,'Paaaaas bien MAXIT atteint' 884 PRINT*,'PROBLEM IRFRMSA dans new_cloud_venus' 885 PRINT*,'you shall not PAAAAAASS' 886 XL=X1 887 XH=X2 888 PRINT*,'Borne XL',XL,'XH',XH 889 ANS=-9.99e99 890 891 DO i=1, MAXIT 892 XM=0.5*(XL+XH) 893 FM=KEEQ(RADIUS,TAIR,XM,LPPWV) 894 S=SQRT(FM*FM-FL*FH) 895 896 IF (FL.GT.FH) THEN 897 FSIGN=1.0 898 ELSE 899 FSIGN=-1.0 900 ENDIF 901 902 XNEW=XM+(XM-XL)*(FSIGN*FM/S) 903 904 ANS=XNEW 905 FNEW=KEEQ(RADIUS,TAIR,ANS,LPPWV) 906 PRINT*,'KEEQ result',FNEW,'T',TAIR,'R',RADIUS 907 IF (SIGN(FM, FNEW).NE.FM) THEN 908 XL=XM 909 FL=FM 910 XH=ANS 911 FH=FNEW 912 ELSEIF (SIGN(FL, FNEW).NE.FL) THEN 913 XH=ANS 914 FH=FNEW 915 ELSEIF (SIGN(FH, FNEW).NE.FH) THEN 916 XL=ANS 917 FL=FNEW 918 ELSE 919 PRINT*,'PROBLEM IRFRMSA dans new_cloud_venus' 920 PRINT*,'you shall not PAAAAAASS' 921 STOP 922 ENDIF 923 ENDDO 924 STOP 925 ELSE 926 PRINT*,'IRFRMSA must be bracketed' 927 IF (FL.EQ.0.0) THEN 928 PRINT*,'IRFRMSA FL == 0',Fl 929 IRFRMSA=X1 930 RETURN 931 ENDIF 932 IF (FH.EQ.0.0) THEN 933 PRINT*,'IRFRMSA FH == 0',FH 934 IRFRMSA=X2 935 RETURN 936 ENDIF 937 IF ((FL.NE.0.).AND.(FH.NE.0.)) THEN 938 PRINT*,'IRFRMSA FH and FL neq 0: ', FL, FH 939 PRINT*,'X1',X1,'X2',X2 940 PRINT*,'Kind F', KIND(FL), KIND(FH) 941 PRINT*,'Kind X', KIND(X1), KIND(X2) 942 PRINT*,'Logical: ',(SIGN(FL,FH).NE.FL) 943 PRINT*,'Logical: ',(SIGN(FH,FL).NE.FH) 944 PRINT*,'nb root BRACWSA',NB 945 STOP 946 ENDIF 947 948 ENDIF 949 ! FIN Test Bracketed values 950 951 END function IRFRMSA 952 953 !***************************************************************************** 954 !* REAL FUNCTION KEEQ() 955 REAL FUNCTION KEEQ(RADIUS,TAIR,WSA,LPPWV) 956 !***************************************************************************** 957 !* Kelvin Equation EQuality 958 !* ln(PPWV_eq) - (2Mh2o sigma)/(R T r rho) - ln(ph2osa) = 0 959 !* 960 961 IMPLICIT NONE 962 963 REAL, INTENT(IN) :: RADIUS,TAIR,WSA,LPPWV 964 223 965 ! Physical constants: 224 REAL MH2O, RGAS 966 REAL MH2O 967 REAL RGAS 225 968 PARAMETER( 226 969 ! Molar weight of water (kg/mole) 227 970 + MH2O=18.0153d-3, 228 971 ! Universal gas constant (J/(mole K)) 229 + RGAS=8.31441d0) 230 ! 231 ! Mathematical constants: 232 REAL PI 233 PARAMETER(PI=3.1415926536d0) 234 972 + RGAS=8.314462175d0) 235 973 ! 236 974 ! External functions needed: 237 REAL PWVSAS_GV,S TSAS,ROSAS975 REAL PWVSAS_GV,SIGMADROPLET,RHODROPLET 238 976 ! PWVSAS_GV: Natural logaritm of water vapor pressure over 239 977 ! sulfuric acid solution 240 ! S TSAS: Surface tension of sulfuric acid solution241 ! R OSAS: Density of sulfuric acid solution978 ! SIGMADROPLET: Surface tension of sulfuric acid solution 979 ! RHODROPLET: Density of sulfuric acid solution 242 980 ! 243 981 ! Auxiliary local variables: 244 REAL DELW,DELLP,C1,C2,W0,W1,W2,F0,F1,WGUESS,LPPWV,RO 245 INTEGER ITERAT,MAXITE 246 REAL WMIN 982 REAL C1 983 247 984 PARAMETER( 248 ! Minimum H2SO4 weight fraction: 249 + WMIN=0.1D0, 250 ! Relative error on iterated weight fraction: 251 + DELW=0.001D0, 252 ! Relative error on iterated ln(pressure): 253 + DELLP=0.0001D0, 254 ! Guess of sulfuric acid mass fraction: 255 + WGUESS=0.7D0, 256 ! Maximum iteration number: 257 + MAXITE=20) 258 259 ! 260 PARAMETER( 261 + C1=2.0d0*MH2O/RGAS, 262 + C2=4.0d0*PI/3.0d0) 263 ! 264 265 !---------------------------------------------------------------------------- 266 ! write(*,*) 'in wgtgv, tair, radius, ppwv ', 267 ! + tair, radius, ppwv 268 269 W0=WGUESS 270 LPPWV=DLOG(PPWV) 271 ! write(*,*) lppwv 272 RO=ROSAS(TAIR,W0) 273 F0=LPPWV-C1*STSAS(TAIR,W0)/(TAIR*RADIUS*RO)-PWVSAS_GV(TAIR,W0) 274 ! write(*,*) 'st pwvsas_gv ', STSAS(TAIR,W0), PWVSAS_GV(TAIR,W0) 275 ! write(*,*) 'F0, RO ', F0, RO 276 W1=W0*1.01D0 277 ITERAT=0 278 !---------------------------------------------------------------------------- 279 10 RO=ROSAS(TAIR,W1) 280 F1=LPPWV-C1*STSAS(TAIR,W1)/(TAIR*RADIUS*RO)-PWVSAS_GV(TAIR,W1) 281 ! write(*,*) 'st pwvsas_gv ', STSAS(TAIR,W1), PWVSAS_GV(TAIR,W1) 282 ! write(*,*) 'F1, RO ', F1, RO 283 IF(ABS(F1-F0).LT.DELLP) THEN 284 WSAS=W1 285 ! write(*,*) 'wsas1 in wgtgv ', WSAS 286 RHOSAS=RO 287 MSA=C2*WSAS*RHOSAS*RADIUS**3 288 ELSE 289 W2=MAX(0.0D0,MIN((F1*W0-F0*W1)/(F1-F0),1.0D0)) 290 ! write(*,*) 'w2 max ', w2 291 ITERAT=ITERAT+1 292 IF(ABS(W2-W1).LT.DELW*ABS(W2).OR.ABS(F1).LT.DELLP.OR. 293 + ITERAT.GT.MAXITE) THEN 294 WSAS=W2 295 ! write(*,*) 'wsas2 in wgtgv ', WSAS 296 RHOSAS=RO 297 MSA=C2*WSAS*RHOSAS*RADIUS**3 298 ELSE 299 W0=W1 300 W1=W2 301 ! write(*,*) 'w0, w1, endloop wgtgv ', W0, W1 302 F0=F1 303 GOTO 10 304 ENDIF 305 ENDIF 306 IF(WSAS.LT.WMIN) THEN 307 WSAS=WMIN 308 RHOSAS=ROSAS(TAIR,WMIN) 309 ENDIF 310 311 if(wsas .eq. 1.0) then 312 wsas=0.999999d0 313 endif 314 315 316 !---------------------------------------------------------------------------- 317 RETURN 318 END 319 320 321 !***************************************************************************** 322 !* REAL FUNCTION ROSAS(TAIR,WSA) 323 REAL FUNCTION ROSAS(TAIR,WSA) 324 !***************************************************************************** 325 !* 326 !* Density of liquid sulfuric acid solution. 327 !* 328 !* Source: John H.Perry (ed.):Chemical Engineers Handbook, 329 !* McGraw-Hill, New York 1963, p. 3-79 & 3-80 330 !* 331 !* The original data set in temp. range 0 ! to 20 ! and weight pct. 332 !* 0 to 100 % has been fitted with a polynomium of two variables 333 !* of order 5 in W and lineary in T. Fit quality better than 0.5 % 334 !* 335 !* Input: TAIR: Temperature (K) 336 !* WSA: Weight fraction of H2SO4 [0;1] 337 !* Output: Density of sulfuric acid solution (kg/m**3) 338 !* 339 ! 340 ! USE real16 341 IMPLICIT NONE 342 ! integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL 343 ! integer, parameter :: real_8 = selected_real_kind(2*precision 344 ! + (1.0_sp_k)) 345 346 INTEGER I 347 REAL TAIR,WSA 348 REAL, DIMENSION(6) :: C 349 REAL, DIMENSION(6) :: A 350 REAL, DIMENSION(6) :: B 351 REAL, DIMENSION(6) :: D 352 DATA (A(I),I=1,6)/ 353 # 1.00190D+03, 5.50496D+02, 1.54093D+03,-4.89219D+03, 7.56555D+03, 354 #-3.92739D+03/ 355 DATA (B(I),I=1,6)/ 356 # 1.98378D+01, 1.02256D+03,-1.48665D+03,-7.24651D+02, 3.68348D+03, 357 #-2.22159D+03/ 358 DATA (D(I),I=1,6)/ 359 #-6.97011E-02,-3.59886D+00, 5.24992D+00, 2.54047D+00,-1.29355D+01, 360 # 7.80553D+00/ 361 !C 362 DO I=1,6 363 C(I)=A(I)+B(I)+D(I)*TAIR 364 ENDDO 365 366 ROSAS=C(1)+WSA*(C(2)+WSA*(C(3)+WSA*(C(4)+WSA*(C(5)+WSA*C(6))))) 367 368 RETURN 369 END function rosas 370 371 ***************************************************************************** 372 * REAL FUNCTION STSAS(TAIR,WSA) * 373 ! REAL FUNCTION STSAS(TAIR,WSA) 374 ***************************************************************************** 375 * 376 * Surface tension of sulfuric acid solution/vapor. 377 * 378 * Source: Tabazadeh et al. JGR, 102,23845,1997 379 * Sabinina & Terpugov: Z. Phys. Chem. A173 ,237, 1935. 380 * 381 * 382 * Input: TAIR: Temperature (K) 383 * WSA: Weight fraction of H2SO4 [0;1] 384 * Output: Surface tension of sulfuric acid solution (N/m) 385 * 386 ! IMPLICIT NONE 387 ! REAL(KIND=4) TAIR,WSA,W 388 ! W=WSA*100.0d0 389 ! STSAS=1.0d-3*(142.35d0-0.96525d0*W-TAIR*(0.22954d0-0.0033948d0*W)) 390 ! RETURN 391 ! END 392 ***************************************************************************** 393 * REAL FUNCTION STSAS(TAIR,WSA) * 394 REAL FUNCTION STSAS(TAIR,WSA) 395 ***************************************************************************** 396 * 397 * Surface tension of sulfuric acid solution/vapor. 398 * 399 * Source: Tabazadeh et al. submitted,1999 400 * Myhre et al., J. Chem. Eng. Data 43,617,1998. 401 * 402 * 403 * Input: TAIR: Temperature (K) 404 * WSA: Weight fraction of H2SO4 [0;1] 405 * Output: Surface tension of sulfuric acid solution (N/m) 406 * 407 ! USE real16 408 IMPLICIT NONE 409 ! integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL 410 ! integer, parameter :: real_8 = selected_real_kind(2*precision 411 ! + (1.0_sp_k)) 412 413 REAL TAIR,WSA,W,T,S180,S220,S260 414 ! 415 W=DBLE(WSA)*100.0D0 416 T=DBLE(TAIR) 417 IF(W.LT.40.0D0) THEN 418 T=DMAX1(180.0D0,DMIN1(T,260.0D0)) 419 S220=(((((8.969257061D-7*W-1.145573827D-4)*W+5.415260617D-3) 420 + *W-1.050692123D-1)*W+5.312072092D-1)*W+82.01197792D0) 421 IF(T.LE.220.0D0) THEN 422 S180=(((((1.736789787D-6*W-1.912224154D-4)*W+7.485866933D-3) 423 + *W-1.103647657D-1)*W+9.541966318D-2)*W+85.75507114D0) 424 ! STSAS=REAL(1.0D-3*(S220+(5.5D0-0.025D0*T)*(S180-S220))) 425 STSAS=1.0D-3*(S220+(5.5D0-0.025D0*T)*(S180-S220)) 426 ELSE IF(T.GT.220.0D0) THEN 427 S260=(((((2.095358048D-7*W-2.384669516D-5)*W+8.87979880D-4) 428 + *W-9.682499074D-3)*W-6.9631232740D-3)*W+77.40682664D0) 429 ! STSAS=REAL(1.0D-3*(S260+(6.5D0-0.025D0*T)*(S220-S260))) 430 STSAS=1.0D-3*(S260+(6.5D0-0.025D0*T)*(S220-S260)) 431 ENDIF 432 ELSE 433 ! STSAS=1.0d-3* 434 ! + REAL(142.35D0-0.96525D0*W-TAIR*(0.22954D0-0.0033948D0*W)) 435 STSAS=1.0d-3* 436 + 142.35D0-0.96525D0*W-TAIR*(0.22954D0-0.0033948D0*W) 437 ENDIF 438 439 RETURN 440 END 985 + C1=2.0d0*MH2O/RGAS) 986 987 988 KEEQ=LPPWV-C1*SIGMADROPLET(WSA,TAIR)/ 989 & (TAIR*RADIUS*RHODROPLET(WSA,TAIR))- 990 & PWVSAS_GV(TAIR,WSA) 991 992 END FUNCTION KEEQ 993 441 994 ***************************************************************************** 442 995 * REAL FUNCTION PWVSAS_GV(TAIR,WSA) … … 466 1019 * External functions needed for calculation of partial molal 467 1020 * properties of pure components at 25 ! as function of W. 468 ! USE real16469 1021 IMPLICIT NONE 470 ! integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL 471 ! integer, parameter :: real_8 = selected_real_kind(2*precision 472 ! + (1.0_sp_k)) 473 474 REAL CPH2O,ALH2O,FFH2O,LH2O 1022 1023 REAL :: CPH2O,ALH2O,FFH2O,LH2O 475 1024 * CPH2O: Partial molal heat capacity of sulfuric acid solution. 476 1025 * ALH2O: Temparature derivative of CPH2O … … 480 1029 ! 481 1030 ! 482 REAL 483 REAL 484 REAL 485 REAL 486 REAL 1031 REAL, INTENT(IN) :: TAIR,WSA 1032 REAL :: ADOT,BDOT,CDOT,DDOT 1033 REAL :: RGAS,MMHGPA 1034 REAL :: K1,K2 1035 REAL :: A,B,C,D,CP,L,F,ALFA 487 1036 ! Physical constants given by Gmitro & Vermeulen: 488 1037 PARAMETER( … … 517 1066 ! 518 1067 PWVSAS_GV=A*DLOG(K1/TAIR)+B/TAIR+C+D*TAIR+MMHGPA 519 RETURN520 END 1068 1069 END FUNCTION PWVSAS_GV 521 1070 ******************************************************************************* 522 1071 * REAL FUNCTION CPH2O(W) … … 530 1079 * Source: Giauque et al.: J. Amer. Chem. Soc. 82,62,1960. 531 1080 * 532 ! USE real16533 1081 IMPLICIT NONE 534 ! integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL 535 ! integer, parameter :: real_8 = selected_real_kind(2*precision 536 ! + (1.0_sp_k)) 537 538 INTEGER NPOINT,I 1082 1083 INTEGER :: NPOINT,I 539 1084 PARAMETER(NPOINT=109) 540 REAL W,WTAB(NPOINT),CPHTAB(NPOINT), 541 + Y2(NPOINT),YWORK(NPOINT),CPH 542 LOGICAL FIRST 1085 REAL, DIMENSION(NPOINT) :: WTAB(NPOINT),CPHTAB(NPOINT), 1086 + Y2(NPOINT),YWORK(NPOINT) 1087 REAL, INTENT(IN):: W 1088 REAL :: CPH 1089 LOGICAL :: FIRST 543 1090 DATA (WTAB(I),I=1,NPOINT)/ 544 1091 +0.00000,0.08932,0.09819,0.10792,0.11980,0.13461,0.15360,0.16525, … … 580 1127 CALL SPLINT(WTAB,CPHTAB,Y2,NPOINT,W,CPH) 581 1128 CPH2O=CPH 582 RETURN583 END 1129 1130 END FUNCTION CPH2O 584 1131 ! 585 1132 ******************************************************************************* 586 REAL 1133 REAL FUNCTION FFH2O(W) 587 1134 * REAL FUNCTION FFH2O(W) 588 1135 ******************************************************************************* … … 594 1141 * Source: Giauque et al.: J. Amer. Chem. Soc. 82,62,1960. 595 1142 * 596 ! USE real16597 1143 IMPLICIT NONE 598 ! integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL 599 ! integer, parameter :: real_8 = selected_real_kind(2*precision 600 ! + (1.0_sp_k)) 601 602 INTEGER NPOINT,I 1144 1145 INTEGER :: NPOINT,I 603 1146 PARAMETER(NPOINT=110) 604 REAL W,WTAB(NPOINT),FFTAB(NPOINT), 605 + Y2(NPOINT),YWORK(NPOINT),FF 606 LOGICAL FIRST 1147 REAL, DIMENSION(NPOINT) :: WTAB,FFTAB,Y2,YWORK 1148 REAL, INTENT(IN) :: W 1149 REAL :: FF 1150 LOGICAL :: FIRST 607 1151 DATA (WTAB(I),I=1,NPOINT)/ 608 1152 +0.00000,0.08932,0.09819,0.10792,0.11980,0.13461,0.15360,0.16525, … … 644 1188 CALL SPLINT(WTAB,FFTAB,Y2,NPOINT,W,FF) 645 1189 FFH2O=FF 646 RETURN647 END 1190 1191 END FUNCTION FFH2O 648 1192 ! 649 1193 ******************************************************************************* … … 658 1202 * Source: Giauque et al.: J. Amer. Chem. Soc. 82,62,1960. 659 1203 * 660 ! USE real16661 1204 IMPLICIT NONE 662 ! integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL 663 ! integer, parameter :: real_8 = selected_real_kind(2*precision 664 ! + (1.0_sp_k)) 665 666 INTEGER NPOINT,I 1205 1206 INTEGER :: NPOINT,I 667 1207 PARAMETER(NPOINT=110) 668 REAL W,WTAB(NPOINT),LTAB(NPOINT), 669 + Y2(NPOINT),YWORK(NPOINT),L 670 LOGICAL FIRST 1208 REAL, DIMENSION(NPOINT) :: WTAB,LTAB,Y2,YWORK 1209 REAL, INTENT(IN) :: W 1210 REAL :: L 1211 LOGICAL :: FIRST 671 1212 DATA (WTAB(I),I=1,NPOINT)/ 672 1213 +0.00000,0.08932,0.09819,0.10792,0.11980,0.13461,0.15360,0.16525, … … 708 1249 CALL SPLINT(WTAB,LTAB,Y2,NPOINT,W,L) 709 1250 LH2O=L 710 RETURN711 END 1251 1252 END FUNCTION LH2O 712 1253 ******************************************************************************* 713 1254 REAL FUNCTION ALH2O(W) … … 721 1262 * Source: Giauque et al.: J. Amer. Chem. Soc. 82,62,1960. 722 1263 * 723 ! USE real16724 1264 IMPLICIT NONE 725 ! integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL 726 ! integer, parameter :: real_8 = selected_real_kind(2*precision 727 ! + (1.0_sp_k)) 728 729 INTEGER NPOINT,I 1265 1266 INTEGER :: NPOINT,I 730 1267 PARAMETER(NPOINT=96) 731 REAL W,WTAB(NPOINT),ATAB(NPOINT), 732 + Y2(NPOINT),YWORK(NPOINT),A 733 LOGICAL FIRST 1268 REAL, DIMENSION(NPOINT) :: WTAB,ATAB,Y2,YWORK 1269 REAL, INTENT(IN) :: W 1270 REAL :: A 1271 LOGICAL :: FIRST 734 1272 DATA (WTAB(I),I=1,NPOINT)/ 735 1273 +0.29517,0.31209, … … 768 1306 CALL SPLINT(WTAB,ATAB,Y2,NPOINT,MAX(WTAB(1),W),A) 769 1307 ALH2O=A 770 RETURN771 END 1308 1309 END FUNCTION ALH2O 772 1310 !****************************************************************************** 773 1311 SUBROUTINE SPLINE(X,Y,N,WORK,Y2) … … 776 1314 ! Y(i)=Y(Xi), to be used for cubic spline calculation. 777 1315 ! 778 ! USE real16779 1316 IMPLICIT NONE 780 ! integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL 781 ! integer, parameter :: real_8 = selected_real_kind(2*precision 782 ! + (1.0_sp_k)) 783 784 INTEGER N,I 785 REAL X(N),Y(N),WORK(N),Y2(N) 1317 1318 INTEGER, INTENT(IN) :: N 1319 INTEGER :: I 1320 REAL, DIMENSION(N), INTENT(IN) :: X,Y 1321 REAL, DIMENSION(N), INTENT(OUT) :: Y2,WORK 786 1322 REAL SIG,P,QN,UN,YP1,YPN 787 1323 … … 819 1355 ENDDO 820 1356 ! 821 RETURN 822 END 1357 END SUBROUTINE SPLINE 823 1358 824 1359 !****************************************************************************** … … 826 1361 !****************************************************************************** 827 1362 ! Cubic spline calculation 828 ! 829 ! USE real16 1363 830 1364 IMPLICIT NONE 831 ! integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL 832 ! integer, parameter :: real_8 = selected_real_kind(2*precision 833 ! + (1.0_sp_k)) 834 835 INTEGER KLO,KHI,N,K836 REAL XA(N),YA(N),Y2A(N)837 REAL X,Y,H,A,B1365 1366 INTEGER, INTENT(IN) :: N 1367 INTEGER :: KLO,KHI,K 1368 REAL, INTENT(IN), DIMENSION(N) :: XA,YA,Y2A 1369 REAL, INTENT(IN) :: X 1370 REAL, INTENT(OUT) :: Y 1371 REAL :: H,A,B 838 1372 ! 839 1373 KLO=1 … … 854 1388 + ((A**3-A)*Y2A(KLO)+(B**3-B)*Y2A(KHI))*(H**2)/6.0d0 855 1389 ! 856 RETURN 857 END 1390 1391 END SUBROUTINE SPLINT 858 1392 !****************************************************************** 859 SUBROUTINE CALNLOG_SAT(ACTSO4,H2SO4,H2O,WFSA,DENSO4,RSTDEV, 860 + RMEDRA,T,RNLOG,H2SO4COND,H2OCOND, 861 + acidps,satpacid) 1393 SUBROUTINE CALCM_SAT(H2SO4,H2O,WSA,DENSO4, 1394 + T,H2SO4COND,H2OCOND,RMTOT) 862 1395 863 1396 ! DERIVE NO (TOTAL NUMBER OF AEROSOL PARTICLES CONCENTRATION) 864 1397 ! FROM TOTAL H2SO4 AND RMOD/SIGMA OF AEROSOL LOG-NORMAL 865 1398 ! SIZE DISTRIBTUION 866 ! ASSUMING ALL THE H2SO4 ABOVE MIXTURE SAT PRESSURE IS CONDENSED1399 ! ASSUMING ALL THE H2SO4 ABOVE MIXTURE SAT PRESSURE modified by H2SO4 activity IS CONDENSED 867 1400 ! --------------------------------------------------------------- 868 1401 ! INPUT: 869 ! ACTSO4: H2SO4 activity 870 ! H2SO4: #/cm3 of total H2SO4 871 ! H2O : #/cm3 of total H2O 872 ! WFSA: aerosol H2SO4 weight fraction (fraction) 873 ! DENSO4: aerosol volumic mass (gr/cm3 = aerosol mass/aerosol volume) 874 !! for total mass, almost same result with ro=1.67 gr/cm3 1402 ! H2SO4: #/m3 of total H2SO4 1403 ! H2O : #/m3 of total H2O 1404 ! WSA: aerosol H2SO4 weight fraction (fraction) 1405 ! DENSO4: aerosol volumic mass (kg/m3 = aerosol mass/aerosol volume) 1406 ! for total mass, almost same result with ro=1.67 gr/cm3 875 1407 ! RSTDEV: standard deviation of aerosol distribution (no unit) 876 ! RMEDRA: median radius (m) 877 ! RMEDR : median radius converti en cm 1408 ! RADIUS: MEDIAN radius (m) 878 1409 ! T: temperature (K) 879 1410 ! 880 1411 ! OUTPUT: 881 ! RNLOG: total number of aerosol particles (VMR) 882 ! RNLOG is in the same units as H2SO4 883 ! if H2SO4 is in number density (for example, molec/cm3), 884 ! RNLOG (number of particles/cm3), etc... 1412 ! RMTOT: Total condensed "Mass" (M_tot_distrib / rho_droplet), sans dimension 1413 ! mais rho_droplet et M_tot_distrib doivent tre de meme dimension 885 1414 ! H2OCOND 886 1415 ! H2SO4COND 887 1416 888 ! USE real16 1417 1418 889 1419 IMPLICIT NONE 890 ! integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL 891 ! integer, parameter :: real_8 = selected_real_kind(2*precision 892 ! + (1.0_sp_k)) 893 894 ! INTEGER NOLAT,NOLEV 895 REAL H2SO4, H2O, WFSA, ACTSO4 896 REAL H2OCOND, H2SO4COND 897 REAL RSTDEV, RMEDRA 898 REAL DENSO4, T 899 REAL RNLOG,RMEDR 1420 1421 REAL, INTENT(IN) :: H2SO4, H2O, WSA 1422 REAL, INTENT(IN) :: DENSO4, T 1423 REAL, INTENT(OUT) :: H2OCOND, H2SO4COND, RMTOT 900 1424 ! working variables 901 INTEGER I,J 902 REAL RMH2S4,PI1,RMTOT 903 REAL DND2,pstand,lpar,acidps 904 REAL x1, satpacid 1425 REAL :: RMH2S4 1426 REAL :: DND2,pstand,lpar,acidps 1427 REAL :: x1, satpacid 905 1428 REAL , DIMENSION(2):: act 906 1429 ! 907 ! masse of an H2SO4 molecule (g) 908 RMH2S4=98.078/(6.02214129e23) 909 910 ! 3/4*PI 911 PI1 =3./(4.0*4.0*ATAN(1.0)) 912 913 RMEDR=RMEDRA*1.e2 !AM: this needs to be in cm! 914 915 pstand=1.01325e5 !Pa 1 atm pressure 916 917 x1=(WFSA/98.08)/(WFSA/98.08 + ((1.-WFSA)/18.0153)) 1430 ! masse of an H2SO4 molecule (kg) 1431 RMH2S4=98.078/(6.02214129E+26) 1432 1433 pstand=1.01325E+5 !Pa 1 atm pressure 1434 1435 x1=(WSA/98.08)/(WSA/98.08 + ((1.-WSA)/18.0153)) 918 1436 919 1437 call zeleznik(x1,t,act) … … 926 1444 acidps = DEXP(acidps) !Pa 927 1445 928 !acid sat.vap. presover mixture (flat surface):1446 !acid sat.vap.PP over mixture (flat surface): 929 1447 satpacid=act(2)*acidps ! Pa 930 1448 931 1449 ! Conversion from Pa to N.D #/m3 932 DND2=satpacid/(1.3806488 e-23*T)1450 DND2=satpacid/(1.3806488E-23*T) 933 1451 ! Conversion from N.D #/m3 TO #/cm3 934 DND2=DND2*1.d-61452 ! DND2=DND2*1.d-6 935 1453 936 ! H2SO4COND N.D #/ cm3 condensee ssi H2SO4>H2SO4sat1454 ! H2SO4COND N.D #/m3 condensee ssi H2SO4>H2SO4sat 937 1455 IF (H2SO4.GE.DND2) THEN 938 1456 H2SO4COND=H2SO4-DND2 939 1457 ! calcul de H2O cond correspondant a H2SO4 cond 940 H2OCOND=H2SO4COND*98.078*(1.0-W FSA)/(18.0153*WFSA)1458 H2OCOND=H2SO4COND*98.078*(1.0-WSA)/(18.0153*WSA) 941 1459 942 1460 ! RMTOT: = Mass of H2SO4 satur per cm3 of air/ Mass of sulfuric acid part of droplet solution per cm3 943 1461 ! RMTOT=M_distrib/rho_droplet 944 1462 945 RMTOT=H2SO4COND*RMH2S4/(DENSO4*WFSA) 946 947 ! 948 ! RNLOG: total number of aerosol particles per cm3 949 RNLOG= RMTOT*EXP(-4.5*DLOG(RSTDEV)*DLOG(RSTDEV)) 950 + *PI1/( RMEDR*RMEDR*RMEDR) 1463 RMTOT=H2SO4COND*RMH2S4/(DENSO4*WSA) 951 1464 952 1465 ! Si on a H2SO4<H2SO4sat on ne condense rien et NDTOT=0 953 1466 ELSE 954 H2SO4COND=0.0 d0955 H2OCOND=0.0 d0956 R NLOG=0.0d01467 H2SO4COND=0.0E+0 1468 H2OCOND=0.0E+0 1469 RMTOT=0.0E+0 957 1470 END IF 958 1471 959 1472 ! Test si H2O en defaut H2Ocond>H2O dispo 960 IF (H2OCOND.GT.H2O) THEN 1473 IF ((H2OCOND.GT.H2O).AND.(H2SO4.GE.DND2)) THEN 1474 1475 ! Si H2O en dfaut, on as pas le bon WSA! 1476 ! En effet, normalement, on a exactement le WSA correspondant a 1477 ! WVg + WVl = WVtot 1478 ! Dans les cas o WVtot, SAtot sont trs faibles (Upper Haze) ou 1479 ! quand T est grand (Lower Haze), le modle reprsente mal le WSA 1480 ! cf carte NCL, avec des max erreur absolue de 0.1 sur le WSA 1481 1482 ! PRINT*,'PROBLEM H2O EN DEFAUT' 1483 ! PRINT*,'H2OCOND',H2OCOND,'H2O',H2O 1484 ! PRINT*,'WSA',WSA,'RHO',DENSO4 1485 ! STOP 1486 961 1487 962 1488 ! On peut alors condenser tout le H2O dispo 963 1489 H2OCOND=H2O 964 1490 ! On met alors egalement a jour le H2SO4 cond correspondant au H2O cond 965 H2SO4COND=H2OCOND*18.0153*W FSA/(98.078*(1.0-WFSA))1491 H2SO4COND=H2OCOND*18.0153*WSA/(98.078*(1.0-WSA)) 966 1492 967 1493 ! RMTOT: = Mass of H2SO4 satur per cm3 of air/ Mass of sulfuric acid part of droplet solution per cm3 … … 969 1495 ! Volume of aerosol/cm3 air 970 1496 971 RMTOT=H2SO4COND*RMH2S4/(DENSO4*WFSA) 972 973 ! 974 ! RNLOG: total number of aerosol particles per cm3 975 RNLOG= RMTOT*EXP(-4.5*DLOG(RSTDEV)*DLOG(RSTDEV)) 976 + *PI1/( RMEDR*RMEDR*RMEDR) 977 1497 RMTOT=H2SO4COND*RMH2S4/(DENSO4*WSA) 1498 978 1499 END IF 979 980 981 982 RETURN 983 END 984 985 !**************************************************************** 986 SUBROUTINE STRAACT(R2SO4,ACTSO4) 987 988 ! H2SO4 ACTIVITY (GIAUQUE) AS A FUNCTION OF H2SO4 WP 989 ! ---------------------------------------- 990 ! INPUT: 991 ! R2SO4: percent (%) of WSA (Weight fraction of Sulfuric Acid) 992 ! 993 ! OUTPUT: 994 ! ACTSO4: H2SO4 activity (percent) 995 ! USE real16 996 IMPLICIT NONE 997 ! integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL 998 ! integer, parameter :: real_8 = selected_real_kind(2*precision 999 ! + (1.0_sp_k)) 1000 1001 1002 ! INTEGER NOLAT,NOLEV 1003 REAL R2SO4, ACTSO4 1004 1005 ! Working variables 1006 INTEGER NN,I,J,JX,JX1 1007 REAL TC,TB,TA,XT 1008 PARAMETER (NN=109) 1009 REAL, DIMENSION(NN) :: XC, X 1010 1011 ! H2SO4 activity 1012 DATA X/ 1013 * 0.0,0.25,0.78,1.437,2.19,3.07,4.03,5.04,6.08 1014 * ,7.13,8.18,14.33,18.59,28.59,39.17,49.49 1015 * ,102.4,157.8,215.7,276.9,341.6,409.8,481.5,556.6 1016 * ,635.5,719.,808.,902.,1000.,1103.,1211.,1322.,1437.,1555. 1017 * ,1677.,1800.,1926.,2054.,2183.,2312.,2442.,2572.,2701.,2829. 1018 * ,2955.,3080.,3203.,3325.,3446.,3564.,3681.,3796.,3910.,4022. 1019 * ,4134.,4351.,4564.,4771.,4974.,5171.,5364.,5551.,5732.,5908. 1020 * ,6079.,6244.,6404.,6559.,6709.,6854.,6994.,7131.,7264.,7393. 1021 * ,7520.,7821.,8105.,8373.,8627.,8867.,9093.,9308.,9511.,9703. 1022 * ,9885.,10060.,10225.,10535.,10819.,11079.,11318.,11537. 1023 * ,11740.,12097.,12407.,12676.,12915.,13126.,13564.,13910. 1024 * ,14191.,14423.,14617.,14786.,10568.,15299.,15491.,15654. 1025 * ,15811./ 1026 ! H2SO4 weight fraction (percent) 1027 DATA XC/ 1028 * 100.0,99.982,99.963,99.945,99.927,99.908,99.890,99.872 1029 * ,99.853,99.835,99.817,99.725,99.634,99.452,99.270 1030 * ,99.090,98.196,97.319,96.457,95.610,94.777,93.959,93.156 1031 * ,92.365,91.588,90.824,90.073,89.334,88.607,87.892,87.188 1032 * ,86.495,85.814,85.143,84.482,83.832,83.191,82.560,81.939 1033 * ,81.327,80.724,80.130,79.545,78.968,78.399,77.839,77.286 1034 * ,76.741,76.204,75.675,75.152,74.637,74.129,73.628,73.133 1035 * ,72.164,71.220,70.300,69.404,68.530,67.678,66.847,66.037 1036 * ,65.245,64.472,63.718,62.981,62.261,61.557,60.868,60.195 1037 * ,59.537,58.893,58.263,57.646,56.159,54.747,53.405,52.126 1038 * ,50.908,49.745,48.634,47.572,46.555,45.580,44.646,43.749 1039 * ,42.059,40.495,39.043,37.691,36.430,35.251,33.107,31.209 1040 * ,29.517,27.999,26.629,23.728,21.397,19.482,17.882,16.525 1041 * ,15.360,13.461,11.980,10.792,9.819,8.932/ 1042 1043 1044 ! HERE LINEAR INTERPOLATIONS 1045 XT=R2SO4 1046 CALL POSACT(XT,XC,NN,JX) 1047 JX1=JX+1 1048 IF(JX.EQ.0) THEN 1049 ACTSO4=0.0 1050 ELSE IF(JX.GE.NN) THEN 1051 ACTSO4=15811.0 1052 ELSE 1053 TC=XT-XC(JX) 1054 TB=X(JX1)-X(JX) 1055 TA=XC(JX1)-XC(JX) 1056 TA=TB/TA 1057 ACTSO4=X(JX)+(TA*TC) 1058 ENDIF 1059 10 CONTINUE 1060 1061 RETURN 1062 END 1063 !******************************************************************** 1064 SUBROUTINE POSACT(XT,X_ARR,N,JX) 1065 1066 ! POSITION OF XT IN THE ARRAY X 1067 ! --------------------------------------------- 1068 ! USE real16 1069 IMPLICIT NONE 1070 ! integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL 1071 ! integer, parameter :: real_8 = selected_real_kind(2*precision 1072 ! + (1.0_sp_k)) 1073 1074 INTEGER N 1075 REAL XT 1076 REAL, DIMENSION(N) :: X_ARR 1077 ! Working variables 1078 INTEGER JX,I 1079 1080 IF(XT.GT.X_ARR(1)) THEN 1081 JX=0 1082 ELSE 1083 DO 10 I=1,N 1084 IF (XT.GT.X_ARR(I)) GO TO 20 1085 10 CONTINUE 1086 20 JX=I 1087 ENDIF 1088 1089 RETURN 1090 END 1500 1501 END SUBROUTINE CALCM_SAT 1091 1502 1092 1503 SUBROUTINE Zeleznik(x,T,act) … … 1098 1509 ! of the aqueous sulfuric acid system to 220K-350K, 1099 1510 ! mole fraction 0,...,1 1100 ! J. Phys. Chem. Ref. Data, Vol. 20, No. 6, pp.1157, 19911511 ! J. Phys. Chem. Ref. Data, Vol. 20, No. 6,PP.1157, 1991 1101 1512 !+++++++++++++++++++++++++++++++++++++++++++++++++++ 1102 1513 1103 ! USE real161104 1514 IMPLICIT NONE 1105 ! integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL 1106 ! integer, parameter :: real_8 = selected_real_kind(2*precision 1107 ! + (1.0_sp_k)) 1108 1109 REAL x,T, activitya, activityw 1110 REAL , DIMENSION(2):: act 1515 1516 REAL, INTENT(IN) :: x,T 1517 REAL :: activitya, activityw 1518 REAL, INTENT(OUT), DIMENSION(2):: act 1111 1519 ! REAL x,T, activitya, activityw 1112 1520 ! REAL, DIMENSION(2):: act … … 1124 1532 !start of functions related to zeleznik activities 1125 1533 1126 FUNCTION m111(T) 1127 ! USE real16 1128 ! integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL 1129 ! integer, parameter :: real_8 = selected_real_kind(2*precision 1130 ! + (1.0_sp_k)) 1131 1132 REAL T,m111 1534 REAL FUNCTION m111(T) 1535 1536 REAL, INTENT(IN) :: T 1133 1537 m111=-23.524503387D0 1134 1538 & +0.0406889449841D0*T … … 1137 1541 END FUNCTION m111 1138 1542 1139 FUNCTION m121(T) 1140 ! USE real16 1141 ! integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL 1142 ! integer, parameter :: real_8 = selected_real_kind(2*precision 1143 ! + (1.0_sp_k)) 1144 1145 REAL m121,T 1543 REAL FUNCTION m121(T) 1544 1545 REAL, INTENT(IN) :: T 1146 1546 m121=1114.58541077D0-1.1833078936D0*T 1147 1547 & -0.00209946114412D0*T**2-246749.842271D0/T … … 1150 1550 1151 1551 FUNCTION m221(T) 1152 ! USE real16 1153 ! integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL 1154 ! integer, parameter :: real_8 = selected_real_kind(2*precision 1155 ! + (1.0_sp_k)) 1156 1157 REAL m221,T 1552 1553 REAL, INTENT(IN) :: T 1158 1554 m221=-80.1488100747D0-0.0116246143257D0*T 1159 1555 & +0.606767928954D-5*T**2+3092.72150882D0/T … … 1161 1557 END FUNCTION m221 1162 1558 1163 FUNCTION m122(T) 1164 ! USE real16 1165 ! integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL 1166 ! integer, parameter :: real_8 = selected_real_kind(2*precision 1167 ! + (1.0_sp_k)) 1168 1169 REAL m122,T 1559 REAL FUNCTION m122(T) 1560 1561 REAL, INTENT(IN) :: T 1170 1562 m122=888.711613784D0-2.50531359687D0*T 1171 1563 & +0.000605638824061D0*T**2-196985.296431D0/T … … 1173 1565 END FUNCTION m122 1174 1566 1175 FUNCTION e111(T) 1176 ! USE real16 1177 ! integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL 1178 ! integer, parameter :: real_8 = selected_real_kind(2*precision 1179 ! + (1.0_sp_k)) 1180 1181 REAL e111,T 1567 REAL FUNCTION e111(T) 1568 1569 REAL, INTENT(IN) :: T 1182 1570 e111=2887.31663295D0-3.32602457749D0*T 1183 1571 & -0.2820472833D-2*T**2-528216.112353D0/T … … 1185 1573 END FUNCTION e111 1186 1574 1187 FUNCTION e121(T) 1188 ! USE real16 1189 ! integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL 1190 ! integer, parameter :: real_8 = selected_real_kind(2*precision 1191 ! + (1.0_sp_k)) 1192 1193 REAL e121,T 1575 REAL FUNCTION e121(T) 1576 1577 REAL, INTENT(IN) :: T 1194 1578 e121=-370.944593249D0-0.690310834523D0*T 1195 1579 & +0.56345508422D-3*T**2-3822.52997064D0/T … … 1197 1581 END FUNCTION e121 1198 1582 1199 FUNCTION e211(T) 1200 ! USE real16 1201 ! integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL 1202 ! integer, parameter :: real_8 = selected_real_kind(2*precision 1203 ! + (1.0_sp_k)) 1204 1205 REAL e211,T 1583 REAL FUNCTION e211(T) 1584 1585 REAL, INTENT(IN) :: T 1206 1586 e211=38.3025318809D0-0.0295997878789D0*T 1207 1587 & +0.120999746782D-4*T**2-3246.97498999D0/T … … 1209 1589 END FUNCTION e211 1210 1590 1211 FUNCTION e221(T) 1212 ! USE real16 1213 ! integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL 1214 ! integer, parameter :: real_8 = selected_real_kind(2*precision 1215 ! + (1.0_sp_k)) 1216 1217 REAL e221,T 1591 REAL FUNCTION e221(T) 1592 1593 REAL, INTENT(IN) :: T 1218 1594 e221=2324.76399402D0-0.141626921317D0*T 1219 1595 & -0.00626760562881D0*T**2-450590.687961D0/T … … 1221 1597 END FUNCTION e221 1222 1598 1223 FUNCTION e122(T) 1224 ! USE real16 1225 ! integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL 1226 ! integer, parameter :: real_8 = selected_real_kind(2*precision 1227 ! + (1.0_sp_k)) 1228 1229 REAL e122,T 1599 REAL FUNCTION e122(T) 1600 1601 REAL, INTENT(IN) :: T 1230 1602 e122=-1633.85547832D0-3.35344369968D0*T 1231 1603 & +0.00710978119903D0*T**2+198200.003569D0/T … … 1233 1605 END FUNCTION e122 1234 1606 1235 FUNCTION e212(T) 1236 ! USE real16 1237 ! integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL 1238 ! integer, parameter :: real_8 = selected_real_kind(2*precision 1239 ! + (1.0_sp_k)) 1240 1241 REAL e212,T 1607 REAL FUNCTION e212(T) 1608 1609 REAL, INTENT(IN) :: T 1242 1610 e212=1273.75159848D0+1.03333898148D0*T 1243 1611 & +0.00341400487633D0*T**2+195290.667051D0/T … … 1245 1613 END FUNCTION e212 1246 1614 1247 FUNCTION lnAa(x1,T) 1248 ! USE real16 1249 ! integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL 1250 ! integer, parameter :: real_8 = selected_real_kind(2*precision 1251 ! + (1.0_sp_k)) 1252 1253 REAL lnAa,T,x1 1254 & ,m111,m121,m221,m122 1615 REAL FUNCTION lnAa(x1,T) 1616 1617 REAL, INTENT(IN) :: T,x1 1618 REAL :: 1619 & m111,m121,m221,m122 1255 1620 & ,e111,e121,e211,e122,e212,e221 1256 1621 lnAa=-( … … 1272 1637 END FUNCTION lnAa 1273 1638 1274 FUNCTION lnAw(x1,T) 1275 ! USE real16 1276 ! integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL 1277 ! integer, parameter :: real_8 = selected_real_kind(2*precision 1278 ! + (1.0_sp_k)) 1279 1280 REAL lnAw,T,x1 1281 & ,m111,m121,m221,m122 1639 REAL FUNCTION lnAw(x1,T) 1640 1641 REAL, INTENT(IN) :: T,x1 1642 REAL :: 1643 & m111,m121,m221,m122 1282 1644 & ,e111,e121,e211,e122,e212,e221 1283 1645 lnAw=-( … … 1296 1658 END FUNCTION lnAw 1297 1659 1298 FUNCTION activitya(xal,T) 1299 ! USE real16 1300 ! integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL 1301 ! integer, parameter :: real_8 = selected_real_kind(2*precision 1302 ! + (1.0_sp_k)) 1303 1304 REAL lnAa,T,xal,activitya 1660 REAL FUNCTION activitya(xal,T) 1661 1662 REAL, INTENT(IN) :: T,xal 1663 REAL :: lnAa 1305 1664 ! & ,m111,m121,m221,m122 & 1306 1665 ! & ,e111,e121,e211,e122,e212,e221 … … 1311 1670 1312 1671 FUNCTION activityw(xal,T) 1313 ! USE real16 1314 ! integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL 1315 ! integer, parameter :: real_8 = selected_real_kind(2*precision 1316 ! + (1.0_sp_k)) 1317 1318 REAL lnAw,T,xal,activityw 1319 ! & ,m111,m121,m221,m122 & 1320 ! & ,e111,e121,e211,e122,e212,e221 1672 1673 REAL, INTENT(IN) :: T,xal 1674 REAL :: lnAw 1675 1321 1676 activityw=DEXP(lnAw(xal,T)-lnAw(1.D-12,T)) 1322 1677 END FUNCTION activityw 1323 1678 1324 1679 ! end of functions related to zeleznik activities 1680 1681 1682 1683 1684 FUNCTION SIGMADROPLET(xmass,t) 1685 ! calculates the surface tension of the liquid in J/m^2 1686 ! xmass=mass fraction of h2so4, t in kelvins 1687 ! about 230-323 K , x=0,...,1 1688 !(valid down to the solid phase limit temp, which depends on molefraction) 1689 IMPLICIT NONE 1690 REAL :: SIGMADROPLET 1691 REAL, INTENT(IN):: xmass, t 1692 REAL :: a, b, t1, tc, xmole 1693 REAL, PARAMETER :: Msa=98.078 1694 REAL, PARAMETER :: Mwv=18.0153 1695 1696 IF (t .LT. 305.15) THEN 1697 !low temperature surface tension 1698 ! Hanna Vehkam‰ki and Markku Kulmala and Ismo Napari 1699 ! and Kari E. J. Lehtinen and Claudia Timmreck and Madis Noppel and Ari Laaksonen, 2002, 1700 ! An improved parameterization for sulfuric acid/water nucleation rates for tropospheric 1701 !and stratospheric conditions, () J. Geophys. Res., 107, pp. 4622-4631 1702 a=0.11864+xmass*(-0.11651+xmass*(0.76852+xmass* 1703 & (-2.40909+xmass*(2.95434-xmass*1.25852)))) 1704 b=-0.00015709+xmass*(0.00040102+xmass*(-0.00239950+xmass* 1705 & (0.007611235+xmass*(-0.00937386+xmass*0.00389722)))) 1706 SIGMADROPLET=a+t*b 1707 ELSE 1708 1709 xmole = (xmass/Msa)*(1./((xmass/Msa)+(1.-xmass)/Mwv)) 1710 ! high temperature surface tension 1711 !H. Vehkam‰ki and M. Kulmala and K.E. J. lehtinen, 2003, 1712 !Modelling binary homogeneous nucleation of water-sulfuric acid vapours: 1713 ! parameterisation for high temperature emissions, () Environ. Sci. Technol., 37, 3392-3398 1714 1715 tc= 647.15*(1.0-xmole)*(1.0-xmole)+900.0*xmole*xmole+ 1716 & 3156.186*xmole*(1-xmole) !critical temperature 1717 t1=1.0-t/tc 1718 a= 0.2358+xmole*(-0.529+xmole*(4.073+xmole*(-12.6707+xmole* 1719 & (15.3552+xmole*(-6.3138))))) 1720 b=-0.14738+xmole*(0.6253+xmole*(-5.4808+xmole*(17.2366+xmole* 1721 & (-21.0487+xmole*(8.719))))) 1722 SIGMADROPLET=(a+b*t1)*t1**(1.256) 1723 END IF 1724 1725 RETURN 1726 END FUNCTION SIGMADROPLET 1727 1728 FUNCTION RHODROPLET(xmass,t) 1729 ! 1730 ! calculates the density of the liquid in kg/m^3 1731 ! xmass=mass fraction of h2so4, t in kelvins 1732 ! Hanna Vehkam‰ki and Markku Kulmala and Ismo Napari 1733 ! and Kari E. J. Lehtinen and Claudia Timmreck and Madis Noppel and Ari Laaksonen, 2002, 1734 ! An improved parameterization for sulfuric acid/water nucleation rates for tropospheric 1735 !and stratospheric conditions, () J. Geophys. Res., 107, pp. 4622-4631 1736 1737 ! about 220-373 K , x=0,...,1 1738 !(valid down to the solid phase limit temp, which depends on molefraction) 1739 1740 IMPLICIT NONE 1741 REAL :: RHODROPLET 1742 REAL, INTENT(IN) :: xmass, t 1743 REAL :: a,b,c 1744 1745 1746 a=0.7681724+xmass*(2.1847140+xmass*(7.1630022+xmass* 1747 & (-44.31447+xmass* 1748 & (88.75606+xmass*(-75.73729+xmass*23.43228))))) 1749 b=1.808225e-3+xmass*(-9.294656e-3+xmass*(-0.03742148+ 1750 & xmass*(0.2565321+xmass*(-0.5362872+xmass* 1751 & (0.4857736-xmass*0.1629592))))) 1752 c=-3.478524e-6+xmass*(1.335867e-5+xmass* 1753 & (5.195706e-5+xmass*(-3.717636e-4+xmass* 1754 & (7.990811e-4+xmass*(-7.458060e-4+xmass*2.58139e-4))))) 1755 RHODROPLET=a+t*(b+c*t) ! g/cm^3 1756 RHODROPLET= RHODROPLET*1.0e3 !kg/m^3 1757 RETURN 1758 END FUNCTION RHODROPLET 1759 1760 1761 1762 -
trunk/LMDZ.VENUS/libf/phyvenus/new_photochemistry_venus.F90
r1305 r1442 10 10 ! USE comgeomphy 11 11 USE chemparam_mod 12 USE infotrac 12 13 13 14 implicit none … … 36 37 ! matrix 37 38 38 double precision, dimension(nesp,nesp) :: mat39 real, dimension(nesp,nesp) :: mat 39 40 integer :: code 40 41 integer, dimension(nesp) :: indx … … 42 43 ! number densities 43 44 44 double precision, dimension(nz,nesp) :: c45 double precision, dimension(nz,nesp) :: cold46 double precision, dimension(nz,nesp) :: cnew45 real, dimension(nz,nesp) :: c 46 real, dimension(nz,nesp) :: cold 47 real, dimension(nz,nesp) :: cnew 47 48 48 49 ! dates, angles … … 80 81 real, dimension(8*nb_reaction_4_max) :: indice_4 81 82 82 double precision, dimension(nz,nb_phot_max) :: v_phot83 double precision, dimension(nz,nb_reaction_3_max) :: v_384 double precision, dimension(nz,nb_reaction_4_max) :: v_485 86 double precision, dimension(nb_reaction_4_max) :: eps_483 real, dimension(nz,nb_phot_max) :: v_phot 84 real, dimension(nz,nb_reaction_3_max) :: v_3 85 real, dimension(nz,nb_reaction_4_max) :: v_4 86 87 real, dimension(nb_reaction_4_max) :: eps_4 87 88 88 89 … … 118 119 119 120 do iz = 1,nz 120 conc(iz) = p(iz)/(1.38 d-19*t(iz))121 conc(iz) = p(iz)/(1.38E-19*t(iz)) 121 122 c(iz,:) = tr(iz,:)*conc(iz) 122 123 cold(iz,:) = c(iz,:) … … 142 143 ! vitesses de reaction 143 144 144 call krates(hetero_ice,hetero_dust, nz, nesp, nj, c, conc, t, p, nb_phot_max, nb_reaction_3_max, nb_reaction_4_max, v_3, v_4, v_phot,sza_input) 145 call krates(hetero_ice,hetero_dust, nz, nesp, nj, c, conc, t, p, nb_phot_max, nb_reaction_3_max, & 146 nb_reaction_4_max, v_3, v_4, v_phot,sza_input) 145 147 146 148 ! IF (n_lon .EQ. 98) THEN … … 175 177 176 178 ! first guess : remplissage de la matrice 177 call fill_matrix(iz, dt_guess, nz, nesp, v_phot, v_3, v_4, eps_4, c,nb_phot_max, nb_reaction_3_max, nb_reaction_4_max, indice_phot, indice_3, indice_4, mat) 179 call fill_matrix(iz, dt_guess, nz, nesp, v_phot, v_3, v_4, eps_4, c,nb_phot_max, nb_reaction_3_max, & 180 nb_reaction_4_max, indice_phot, indice_3, indice_4, mat) 178 181 179 182 ! first guess : resolution du systeme lineaire … … 183 186 ! eliminate small values 184 187 185 where (cnew(iz,:)/conc(iz) < 1. d-30)188 where (cnew(iz,:)/conc(iz) < 1.E-30) 186 189 cnew(iz,:) = 0. 187 190 end where … … 194 197 curv = 2.*(ratio*cnew(iz,i_o) - (1. + ratio)*c(iz,i_o) + cold(iz,i_o)) & 195 198 /(1. + ratio) 196 e1 = (curv/(cnew(iz,i_o) + cnew(iz,i_o3) + eps))*100.0 d0199 e1 = (curv/(cnew(iz,i_o) + cnew(iz,i_o3) + eps))*100.0E+0 197 200 198 201 e1 = abs(e1) … … 204 207 /(1. + ratio) 205 208 e2 = (curv/(cnew(iz,i_h) + cnew(iz,i_oh) + cnew(iz,i_ho2) + & 206 2.*cnew(iz,i_h2o2)+ eps))*100.0 d0209 2.*cnew(iz,i_h2o2)+ eps))*100.0E+0 207 210 208 211 e2 = abs(e2) … … 213 216 curv = 2.*(ratio*cnew(iz,i_so) - (1. + ratio)*c(iz,i_so) + cold(iz,i_so)) & 214 217 /(1. + ratio) 215 e3 = (curv/(cnew(iz,i_s) + cnew(iz,i_so) + cnew(iz,i_so2)+ eps))*100.0 d0218 e3 = (curv/(cnew(iz,i_s) + cnew(iz,i_so) + cnew(iz,i_so2)+ eps))*100.0E+0 216 219 217 220 e3 = abs(e3) … … 234 237 235 238 ! remplissage de la matrix 236 call fill_matrix(iz, dt_corrected, nz, nesp, v_phot, v_3, v_4, eps_4, c,nb_phot_max, nb_reaction_3_max, nb_reaction_4_max, indice_phot, indice_3, indice_4, mat) 239 call fill_matrix(iz, dt_corrected, nz, nesp, v_phot, v_3, v_4, eps_4, c,nb_phot_max, nb_reaction_3_max, & 240 nb_reaction_4_max, indice_phot, indice_3, indice_4, mat) 237 241 238 242 ! resolution du systeme lineaire … … 245 249 ! eliminate small values 246 250 247 where (cnew(iz,:)/conc(iz) < 1. d-30)251 where (cnew(iz,:)/conc(iz) < 1.E-30) 248 252 cnew(iz,:) = 0. 249 253 end where … … 251 255 cold(iz,:) = c(iz,:) 252 256 c(iz,:) = cnew(iz,:) 253 cnew(iz,:) = 0.0 d0257 cnew(iz,:) = 0.0E+0 254 258 255 259 time = time + dt_corrected 256 260 dt_guess = dt_corrected ! pour first-guess à la prochaine iteration 257 261 262 ! DO iesp=1, nesp 263 ! IF (c(iz,iesp)/conc(iz).GT.1.0) THEN 264 ! PRINT*,'!!!! PROBLEM CHIMIE !!!!' 265 ! PRINT*,'!!!! PROBLEM TRAC !!!!' 266 ! DO i=1,nesp 267 ! PRINT*,tname(i),c(iz,i)/conc(iz) 268 ! PRINT*,'old' ,cold(iz,i)/conc(iz) 269 ! ENDDO 270 ! DO i=1,nb_reaction_4_max 271 ! PRINT*,'v_4',i,v_4(iz,i) 272 ! ENDDO 273 ! DO i=1,nb_reaction_3_max 274 ! PRINT*,'v_3',i,v_3(iz,i) 275 ! ENDDO 276 ! DO i=1,nb_phot_max 277 ! PRINT*,'v_phot',i,v_phot(iz,i) 278 ! ENDDO 279 ! PRINT*,'T',t(iz),'P',p(iz) 280 ! PRINT*,'niv',iz,'sza',sza_input 281 ! PRINT*,'iteration',iter 282 ! STOP 283 ! ENDIF 284 ! ENDDO 285 286 ! DO iesp=1, nb_reaction_4_max 287 ! IF (v_4(iz,iesp).LT.0.0) THEN 288 ! PRINT*,'!!!! PROBLEM CHIMIE !!!!' 289 ! PRINT*,'!!!! PROBLEM V4 !!!!' 290 ! DO i=1,nesp 291 ! PRINT*,tname(i),c(iz,i)/conc(iz) 292 ! PRINT*,'old' ,cold(iz,i)/conc(iz) 293 ! ENDDO 294 ! DO i=1,nb_reaction_4_max 295 ! PRINT*,'v_4',i,v_4(iz,i) 296 ! ENDDO 297 ! DO i=1,nb_reaction_3_max 298 ! PRINT*,'v_3',i,v_3(iz,i) 299 ! ENDDO 300 ! DO i=1,nb_phot_max 301 ! PRINT*,'v_phot',i,v_phot(iz,i) 302 ! ENDDO 303 ! PRINT*,'T',t(iz),'P',p(iz) 304 ! PRINT*,'niv',iz,'sza',sza_input 305 ! PRINT*,'iteration',iter 306 ! STOP 307 ! ENDIF 308 ! ENDDO 309 310 ! DO iesp=1, nb_reaction_3_max 311 ! IF (v_3(iz,iesp).LT.0.0) THEN 312 ! PRINT*,'!!!! PROBLEM CHIMIE !!!!' 313 ! PRINT*,'!!!! PROBLEM V3 !!!!' 314 ! DO i=1,nesp 315 ! PRINT*,tname(i),c(iz,i)/conc(iz) 316 ! PRINT*,'old' ,cold(iz,i)/conc(iz) 317 ! ENDDO 318 ! DO i=1,nb_reaction_4_max 319 ! PRINT*,'v_4',i,v_4(iz,i) 320 ! ENDDO 321 ! DO i=1,nb_reaction_3_max 322 ! PRINT*,'v_3',i,v_3(iz,i) 323 ! ENDDO 324 ! DO i=1,nb_phot_max 325 ! PRINT*,'v_phot',i,v_phot(iz,i) 326 ! ENDDO 327 ! PRINT*,'T',t(iz),'P',p(iz) 328 ! PRINT*,'niv',iz,'sza',sza_input 329 ! PRINT*,'iteration',iter 330 ! STOP 331 ! ENDIF 332 ! ENDDO 333 334 ! DO iesp=1, nb_phot_max 335 ! IF (v_phot(iz,iesp).LT.0.0) THEN 336 ! PRINT*,'!!!! PROBLEM CHIMIE !!!!' 337 ! PRINT*,'!!!! PROBLEM VPHOT !!!!' 338 ! DO i=1,nesp 339 ! PRINT*,tname(i),c(iz,i)/conc(iz) 340 ! PRINT*,'old' ,cold(iz,i)/conc(iz) 341 ! ENDDO 342 ! DO i=1,nb_reaction_4_max 343 ! PRINT*,'v_4',i,v_4(iz,i) 344 ! ENDDO 345 ! DO i=1,nb_reaction_3_max 346 ! PRINT*,'v_3',i,v_3(iz,i) 347 ! ENDDO 348 ! DO i=1,nb_phot_max 349 ! PRINT*,'v_phot',i,v_phot(iz,i) 350 ! ENDDO 351 ! PRINT*,'T',t(iz),'P',p(iz) 352 ! PRINT*,'niv',iz,'sza',sza_input 353 ! PRINT*,'iteration',iter 354 ! STOP 355 ! ENDIF 356 ! ENDDO 357 258 358 end do ! while (time < ptimestep) 259 359 260 360 261 ! Actualisation des VMR traceurs avec valeurs minimales 1 d-30262 263 tr(iz,:) = max(c(iz,:)/conc(iz),1.0 d-30)264 265 361 ! Actualisation des VMR traceurs avec valeurs minimales 1E-30 362 363 tr(iz,:) = max(c(iz,:)/conc(iz),1.0E-30) 364 365 266 366 END DO ! fin de boucle sur les niveaux 267 367 … … 289 389 290 390 IF(n_lon .EQ. 1) THEN 291 !PRINT*,'On est en 1D'391 PRINT*,'On est en 1D' 292 392 !PRINT*,"DEBUT rate_save" 293 393 CALL rate_save(nz,p(:),t(:),tr(:,:),nesp,v_phot(:,:),v_3(:,:),v_4(:,:)) … … 331 431 read(30,'(7e11.4)') (jphot(iso2,isza,iz,ij), ij = 1,nj) 332 432 do ij = 1,nj 333 if (jphot(iso2,isza,iz,ij) == 1. d-30) then433 if (jphot(iso2,isza,iz,ij) == 1.E-30) then 334 434 jphot(iso2,isza,iz,ij) = 0. 335 435 end if … … 2352 2452 2353 2453 integer :: nb_phot_max 2354 double precision, dimension(nz,nb_phot_max), INTENT(INOUT) :: v_phot2355 2356 mugaz = 43.44 d-32357 avogadro = 6.022 e232454 real, dimension(nz,nb_phot_max), INTENT(INOUT) :: v_phot 2455 2456 mugaz = 43.44E-3 2457 avogadro = 6.022E+23 2358 2458 gvenus = 8.87 2359 2459 2360 coef = avogadro/(gvenus*mugaz)*1. d-42460 coef = avogadro/(gvenus*mugaz)*1.E-4 2361 2461 2362 2462 ! day/night test … … 2557 2657 i001, i002 2558 2658 2559 double precision, INTENT(IN), dimension(nz,nesp) :: c2659 real, INTENT(IN), dimension(nz,nesp) :: c 2560 2660 2561 2661 integer :: nb_phot_max, nb_reaction_3_max, nb_reaction_4_max, nb_reaction_3, nb_reaction_4, nb_phot 2562 2662 2563 double precision, dimension(nz,nb_phot_max) :: v_phot2564 double precision, dimension(nz,nb_reaction_3_max) :: v_32565 double precision, dimension(nz,nb_reaction_4_max) :: v_42663 real, dimension(nz,nb_phot_max) :: v_phot 2664 real, dimension(nz,nb_reaction_3_max) :: v_3 2665 real, dimension(nz,nb_reaction_4_max) :: v_4 2566 2666 2567 2667 pi = acos(-1.) … … 2579 2679 ! jpl 2003 2580 2680 2581 a001(:) = 2.5*6.0 d-34*(t(:)/300.)**(-2.4)*conc(:)2681 a001(:) = 2.5*6.0E-34*(t(:)/300.)**(-2.4)*conc(:) 2582 2682 2583 2683 nb_reaction_4 = nb_reaction_4 + 1 … … 2588 2688 ! Tsang and Hampson, J. Chem. Phys. Ref. Data, 15, 1087, 1986 2589 2689 2590 ! a002(:) = 2.5*5.2 d-35*exp(900./t(:))*conc(:)2690 ! a002(:) = 2.5*5.2E-35*exp(900./t(:))*conc(:) 2591 2691 2592 2692 ! Campbell and Gray, Chem. Phys. Lett., 18, 607, 1973 2593 2693 2594 a002(:) = 2.5*9.46 d-34*exp(485./t(:))*conc(:) ! nist expression2694 a002(:) = 2.5*9.46E-34*exp(485./t(:))*conc(:) ! nist expression 2595 2695 2596 2696 nb_reaction_3 = nb_reaction_3 + 1 … … 2601 2701 ! jpl 2003 2602 2702 2603 a003(:) = 8.0 d-12*exp(-2060./t(:))2703 a003(:) = 8.0E-12*exp(-2060./t(:)) 2604 2704 2605 2705 nb_reaction_4 = nb_reaction_4 + 1 … … 2614 2714 ! jpl 2006 2615 2715 2616 b001(:) = 7.5 d-11*exp(115./t(:))2716 b001(:) = 7.5E-11*exp(115./t(:)) 2617 2717 2618 2718 nb_phot = nb_phot + 1 … … 2623 2723 ! jpl 2006 2624 2724 2625 b002(:) = 1.63 d-10*exp(60./t(:))2725 b002(:) = 1.63E-10*exp(60./t(:)) 2626 2726 2627 2727 nb_reaction_4 = nb_reaction_4 + 1 … … 2632 2732 ! jpl 2003 2633 2733 2634 b003(:) = 1.1 d-102734 b003(:) = 1.1E-10 2635 2735 2636 2736 nb_reaction_4 = nb_reaction_4 + 1 … … 2641 2741 ! jpl 2006 2642 2742 2643 b004(:) = 3.3 d-11*exp(55./t(:))2743 b004(:) = 3.3E-11*exp(55./t(:)) 2644 2744 2645 2745 nb_phot = nb_phot + 1 … … 2650 2750 ! jpl 2003 2651 2751 2652 b005(:) = 1.2 d-102752 b005(:) = 1.2E-10 2653 2753 2654 2754 nb_reaction_4 = nb_reaction_4 + 1 … … 2659 2759 ! jpl 2003 2660 2760 2661 b006(:) = 1.2 d-102761 b006(:) = 1.2E-10 2662 2762 2663 2763 nb_reaction_4 = nb_reaction_4 + 1 … … 2672 2772 ! jpl 2003 2673 2773 2674 c001(:) = 3.0 d-11*exp(200./t(:))2774 c001(:) = 3.0E-11*exp(200./t(:)) 2675 2775 2676 2776 nb_reaction_4 = nb_reaction_4 + 1 … … 2681 2781 ! jpl 2003 2682 2782 2683 c002(:) = 2.2 d-11*exp(120./t(:))2783 c002(:) = 2.2E-11*exp(120./t(:)) 2684 2784 2685 2785 nb_reaction_4 = nb_reaction_4 + 1 … … 2690 2790 ! jpl 2003 2691 2791 2692 c003(:) = 1.4 d-10*exp(-470./t(:))2792 c003(:) = 1.4E-10*exp(-470./t(:)) 2693 2793 2694 2794 nb_reaction_4 = nb_reaction_4 + 1 … … 2699 2799 ! jpl 2006 2700 2800 2701 c004(:) = 7.2 d-112801 c004(:) = 7.2E-11 2702 2802 2703 2803 nb_reaction_4 = nb_reaction_4 + 1 … … 2708 2808 ! jpl 2006 2709 2809 2710 c005(:) = 6.9 d-122810 c005(:) = 6.9E-12 2711 2811 2712 2812 nb_reaction_4 = nb_reaction_4 + 1 … … 2717 2817 ! jpl 2006 2718 2818 2719 c006(:) = 1.6 d-122819 c006(:) = 1.6E-12 2720 2820 2721 2821 nb_reaction_4 = nb_reaction_4 + 1 … … 2726 2826 ! jpl 2003 2727 2827 2728 c007(:) = 4.8 d-11*exp(250./t(:))2828 c007(:) = 4.8E-11*exp(250./t(:)) 2729 2829 2730 2830 nb_reaction_4 = nb_reaction_4 + 1 … … 2735 2835 ! jpl 2006 2736 2836 2737 ! c008(:) = 3.5 d-13*exp(430./t(:))2837 ! c008(:) = 3.5E-13*exp(430./t(:)) 2738 2838 2739 2839 ! christensen et al., grl, 13, 2002 2740 2840 2741 c008(:) = 1.5 d-12*exp(19./t(:))2841 c008(:) = 1.5E-12*exp(19./t(:)) 2742 2842 2743 2843 nb_reaction_3 = nb_reaction_3 + 1 … … 2748 2848 ! jpl 2006 2749 2849 2750 c009(:) = 1.8 d-122850 c009(:) = 1.8E-12 2751 2851 2752 2852 nb_reaction_4 = nb_reaction_4 + 1 … … 2757 2857 ! jpl 2006 2758 2858 2759 c010(:) = 2.8 d-12*exp(-1800./t(:))2859 c010(:) = 2.8E-12*exp(-1800./t(:)) 2760 2860 2761 2861 nb_reaction_4 = nb_reaction_4 + 1 … … 2767 2867 2768 2868 do iz = 1,nz 2769 ak0 = 2.5*4.4 d-32*(t(iz)/300.)**(-1.3)2770 ak1 = 4.7 d-11*(t(iz)/300.)**(-0.2)2869 ak0 = 2.5*4.4E-32*(t(iz)/300.)**(-1.3) 2870 ak1 = 4.7E-11*(t(iz)/300.)**(-0.2) 2771 2871 2772 2872 rate = (ak0*conc(iz))/(1. + ak0*conc(iz)/ak1) … … 2782 2882 ! jpl 2003 2783 2883 2784 c012(:) = 1.4 d-12*exp(-2000./t(:))2884 c012(:) = 1.4E-12*exp(-2000./t(:)) 2785 2885 2786 2886 nb_reaction_4 = nb_reaction_4 + 1 … … 2791 2891 ! jpl 2006 2792 2892 2793 c013(:) = 1.8 d-122893 c013(:) = 1.8E-12 2794 2894 2795 2895 nb_reaction_3 = nb_reaction_3 + 1 … … 2800 2900 ! jpl 2003 2801 2901 2802 c014(:) = 1.7 d-12*exp(-940./t(:))2902 c014(:) = 1.7E-12*exp(-940./t(:)) 2803 2903 2804 2904 nb_reaction_4 = nb_reaction_4 + 1 … … 2809 2909 ! jpl 2003 2810 2910 2811 c015(:) = 1.0 d-14*exp(-490./t(:))2911 c015(:) = 1.0E-14*exp(-490./t(:)) 2812 2912 2813 2913 nb_reaction_4 = nb_reaction_4 + 1 … … 2818 2918 ! jpl 2003 2819 2919 2820 c016(:) = 2.5*1.7 d-33*exp(1000./t(:))*conc(:)2920 c016(:) = 2.5*1.7E-33*exp(1000./t(:))*conc(:) 2821 2921 2822 2922 nb_reaction_3 = nb_reaction_3 + 1 … … 2828 2928 2829 2929 do iz = 1,nz 2830 ak0 = 2.5*6.9 d-31*(t(iz)/300.)**(-1.0)2831 ak1 = 2.6 d-11*(t(iz)/300.)**(0.0)2930 ak0 = 2.5*6.9E-31*(t(iz)/300.)**(-1.0) 2931 ak1 = 2.6E-11*(t(iz)/300.)**(0.0) 2832 2932 2833 2933 rate = (ak0*conc(iz))/(1. + ak0*conc(iz)/ak1) … … 2843 2943 ! baulch et al., 2005 2844 2944 2845 c018(:) = 2.5*1.8 d-30*(t(:)**(-1.0))*conc(:)2945 c018(:) = 2.5*1.8E-30*(t(:)**(-1.0))*conc(:) 2846 2946 2847 2947 nb_reaction_3 = nb_reaction_3 + 1 … … 2856 2956 ! jpl 2006 2857 2957 2858 d001(:) = 5.1 d-12*exp(210./t(:))2958 d001(:) = 5.1E-12*exp(210./t(:)) 2859 2959 2860 2960 !--- d002: no + o3 -> no2 + o2 … … 2862 2962 ! jpl 2006 2863 2963 2864 d002(:) = 3.0 d-12*exp(-1500./t(:))2964 d002(:) = 3.0E-12*exp(-1500./t(:)) 2865 2965 2866 2966 !--- d003: no + ho2 -> no2 + oh … … 2868 2968 ! jpl 2006 2869 2969 2870 d003(:) = 3.5 d-12*exp(250./t(:))2970 d003(:) = 3.5E-12*exp(250./t(:)) 2871 2971 2872 2972 !---------------------------------------------------------------------- … … 2878 2978 ! jpl 2003 2879 2979 2880 ! e001(:) = 1.5 d-13*(1 + 0.6*p(:)/1013.)2980 ! e001(:) = 1.5E-13*(1 + 0.6*p(:)/1013.) 2881 2981 2882 2982 ! mccabe et al., grl, 28, 3135, 2001 2883 2983 2884 ! e001(:) = 1.57 d-13 + 3.54d-33*conc(:)2984 ! e001(:) = 1.57E-13 + 3.54E-33*conc(:) 2885 2985 2886 2986 ! jpl 2006 2887 2987 2888 ! ak0 = 1.5 d-13*(t(:)/300.)**(0.6)2889 ! ak1 = 2.1 d-9*(t(:)/300.)**(6.1)2988 ! ak0 = 1.5E-13*(t(:)/300.)**(0.6) 2989 ! ak1 = 2.1E-9*(t(:)/300.)**(6.1) 2890 2990 ! rate1 = ak0/(1. + ak0/(ak1/conc(:))) 2891 2991 ! xpo1 = 1./(1. + alog10(ak0/(ak1/conc(:)))**2) 2892 2992 2893 ! ak0 = 5.9 d-33*(t(:)/300.)**(-1.4)2894 ! ak1 = 1.1 d-12*(t(:)/300.)**(1.3)2993 ! ak0 = 5.9E-33*(t(:)/300.)**(-1.4) 2994 ! ak1 = 1.1E-12*(t(:)/300.)**(1.3) 2895 2995 ! rate2 = (ak0*conc(:))/(1. + ak0*conc(:)/ak1) 2896 2996 ! xpo2 = 1./(1. + alog10((ak0*conc(:))/ak1)**2) … … 2902 3002 do iz = 1,nz 2903 3003 k1a0 = 1.34*2.5*conc(iz) & 2904 *1/(1/(3.62 d-26*t(iz)**(-2.739)*exp(-20./t(iz))) &2905 + 1/(6.48 d-33*t(iz)**(0.14)*exp(-57./t(iz)))) ! corrige de l'erreur publi2906 k1b0 = 1.17 d-19*t(iz)**(2.053)*exp(139./t(iz)) &2907 + 9.56 d-12*t(iz)**(-0.664)*exp(-167./t(iz))2908 k1ainf = 1.52 d-17*t(iz)**(1.858)*exp(28.8/t(iz)) &2909 + 4.78 d-8*t(iz)**(-1.851)*exp(-318./t(iz))3004 *1/(1/(3.62E-26*t(iz)**(-2.739)*exp(-20./t(iz))) & 3005 + 1/(6.48E-33*t(iz)**(0.14)*exp(-57./t(iz)))) ! corrige de l'erreur publi 3006 k1b0 = 1.17E-19*t(iz)**(2.053)*exp(139./t(iz)) & 3007 + 9.56E-12*t(iz)**(-0.664)*exp(-167./t(iz)) 3008 k1ainf = 1.52E-17*t(iz)**(1.858)*exp(28.8/t(iz)) & 3009 + 4.78E-8*t(iz)**(-1.851)*exp(-318./t(iz)) 2910 3010 x = k1a0/(k1ainf - k1b0) 2911 3011 y = k1b0/(k1ainf - k1b0) … … 2926 3026 ! tsang and hampson, 1986. 2927 3027 2928 e002(:) = 2.5*6.5 d-33*exp(-2184./t(:))*conc(:)3028 e002(:) = 2.5*6.5E-33*exp(-2184./t(:))*conc(:) 2929 3029 2930 3030 nb_reaction_4 = nb_reaction_4 + 1 … … 2939 3039 ! jpl 2011 2940 3040 2941 f001(:) = 1.0 d-103041 f001(:) = 1.0E-10 2942 3042 2943 3043 nb_reaction_4 = nb_reaction_4 + 1 … … 2948 3048 ! jpl 2011 2949 3049 2950 f002(:) = 3.6 d-113050 f002(:) = 3.6E-11 2951 3051 2952 3052 nb_reaction_4 = nb_reaction_4 + 1 … … 2957 3057 ! jpl 2006 2958 3058 2959 f003(:) = 1.0 d-11*exp(-3300./t(:))3059 f003(:) = 1.0E-11*exp(-3300./t(:)) 2960 3060 2961 3061 nb_reaction_4 = nb_reaction_4 + 1 … … 2966 3066 ! jpl 2006 2967 3067 2968 f004(:) = 2.6 d-12*exp(-350./t(:))3068 f004(:) = 2.6E-12*exp(-350./t(:)) 2969 3069 2970 3070 nb_reaction_4 = nb_reaction_4 + 1 … … 2975 3075 ! jpl 2006 2976 3076 2977 f005(:) = 2.8 d-11*exp(85./t(:))3077 f005(:) = 2.8E-11*exp(85./t(:)) 2978 3078 2979 3079 nb_reaction_4 = nb_reaction_4 + 1 … … 2984 3084 ! jpl 2006 2985 3085 2986 f006(:) = 7.4 d-12*exp(270./t(:))3086 f006(:) = 7.4E-12*exp(270./t(:)) 2987 3087 2988 3088 nb_reaction_4 = nb_reaction_4 + 1 … … 2993 3093 ! jpl 2006 2994 3094 2995 f007(:) = 6.0 d-13*exp(230./t(:))3095 f007(:) = 6.0E-13*exp(230./t(:)) 2996 3096 2997 3097 nb_reaction_4 = nb_reaction_4 + 1 … … 3002 3102 ! jpl 2006 3003 3103 3004 f008(:) = 3.05 d-11*exp(-2270./t(:))3104 f008(:) = 3.05E-11*exp(-2270./t(:)) 3005 3105 3006 3106 nb_reaction_4 = nb_reaction_4 + 1 … … 3011 3111 ! jpl 2006 3012 3112 3013 f009(:) = 2.3 d-11*exp(-200./t(:))3113 f009(:) = 2.3E-11*exp(-200./t(:)) 3014 3114 3015 3115 nb_reaction_4 = nb_reaction_4 + 1 … … 3020 3120 ! jpl 2006 3021 3121 3022 f010(:) = 4.1 d-11*exp(-450./t(:))3122 f010(:) = 4.1E-11*exp(-450./t(:)) 3023 3123 3024 3124 nb_reaction_4 = nb_reaction_4 + 1 … … 3029 3129 ! jpl 2006 3030 3130 3031 f011(:) = 1.8 d-11*exp(170./t(:))3131 f011(:) = 1.8E-11*exp(170./t(:)) 3032 3132 3033 3133 nb_reaction_4 = nb_reaction_4 + 1 … … 3038 3138 ! jpl 2006 3039 3139 3040 f012(:) = 1.1 d-11*exp(-980./t(:))3140 f012(:) = 1.1E-11*exp(-980./t(:)) 3041 3141 3042 3142 nb_reaction_4 = nb_reaction_4 + 1 … … 3047 3147 ! jpl 2011 + nicovich et al., j. phys. chem., 1990 3048 3148 3049 f013(:) = 3.2*1.3 d-33*(t(:)/300.)**(-3.8)*conc(:)3149 f013(:) = 3.2*1.3E-33*(t(:)/300.)**(-3.8)*conc(:) 3050 3150 3051 3151 nb_reaction_4 = nb_reaction_4 + 1 … … 3056 3156 ! jpl 2011 3057 3157 3058 ! deq(:) = 3.2*3.5 d-25*exp(3730./t(:))3158 ! deq(:) = 3.2*3.5E-25*exp(3730./t(:)) 3059 3159 3060 3160 ! mills, 1998 3061 3161 3062 deq(:) = 1.6 d-25*exp(4000./t(:))3162 deq(:) = 1.6E-25*exp(4000./t(:)) 3063 3163 3064 3164 f014(:) = f013(:)/(deq(:)*conc(:)) … … 3076 3176 ! yung and demore, icarus, 51, 199-247, 1982. 3077 3177 3078 f015(:) = 5.7 d-15*exp(500./t(:))*conc(:) &3178 f015(:) = 5.7E-15*exp(500./t(:))*conc(:) & 3079 3179 /(1.e17 + 0.05*conc(:)) 3080 3180 … … 3090 3190 ! 0.5 clco3 + 0.5 cl -> clo + 0.5 co2 3091 3191 3092 f016(:) = 1.0 d-113192 f016(:) = 1.0E-11 3093 3193 3094 3194 nb_reaction_4 = nb_reaction_4 + 1 … … 3106 3206 ! 0.5 clco3 + 0.5 o -> o2 + co2 3107 3207 3108 f017(:) = 1.0 d-113208 f017(:) = 1.0E-11 3109 3209 3110 3210 nb_reaction_4 = nb_reaction_4 + 1 … … 3116 3216 !--- f018: clo + ho2 -> hocl + o2 3117 3217 3118 f018(:) = 2.7 d-12*exp(220./t(:))3218 f018(:) = 2.7E-12*exp(220./t(:)) 3119 3219 3120 3220 nb_reaction_4 = nb_reaction_4 + 1 … … 3123 3223 !--- f019: oh + hocl -> h2o + clo 3124 3224 3125 f019(:) = 3.0 d-12*exp(-500./t(:))3225 f019(:) = 3.0E-12*exp(-500./t(:)) 3126 3226 3127 3227 nb_reaction_4 = nb_reaction_4 + 1 … … 3130 3230 !--- f020: o + hocl -> oh + clo 3131 3231 3132 f020(:) = 1.7 d-133232 f020(:) = 1.7E-13 3133 3233 3134 3234 nb_reaction_4 = nb_reaction_4 + 1 … … 3139 3239 ! donohoue et al., j. phys. chem. a, 109, 7732-7741, 2005 3140 3240 3141 ! f021(:) = 2.5*8.4 d-33*exp(850.*(1./t(:) - 1./298.))*conc(:)3241 ! f021(:) = 2.5*8.4E-33*exp(850.*(1./t(:) - 1./298.))*conc(:) 3142 3242 3143 3243 ! valeur utilisee par Zhang et al., 2011: 3144 3244 3145 f021(:) = 2.6 d-33*exp(900./t(:))*conc(:)3245 f021(:) = 2.6E-33*exp(900./t(:))*conc(:) 3146 3246 3147 3247 nb_reaction_3 = nb_reaction_3 + 1 … … 3152 3252 ! yung et al., icarus, 1982 (estimated) 3153 3253 3154 f022(:) = 3.0 d-113254 f022(:) = 3.0E-11 3155 3255 3156 3256 nb_reaction_4 = nb_reaction_4 + 1 … … 3161 3261 ! jpl 2011 3162 3262 3163 f023(:) = 2.0 d-103263 f023(:) = 2.0E-10 3164 3264 3165 3265 nb_reaction_4 = nb_reaction_4 + 1 … … 3170 3270 ! baulch et al., j. phys. chem. ref. data, 1981 3171 3271 3172 f024(:) = 1.43 d-10*exp(-591./t(:))3272 f024(:) = 1.43E-10*exp(-591./t(:)) 3173 3273 3174 3274 nb_reaction_4 = nb_reaction_4 + 1 … … 3179 3279 ! baulch et al., j. phys. chem. ref. data, 1981 3180 3280 3181 f025(:) = 2.16 d-9*exp(-1670./t(:))3281 f025(:) = 2.16E-9*exp(-1670./t(:)) 3182 3282 3183 3283 nb_reaction_4 = nb_reaction_4 + 1 … … 3188 3288 ! zhang et al., icarus, 2011 (estimated) 3189 3289 3190 f026(:) = 5.0 d-113290 f026(:) = 5.0E-11 3191 3291 3192 3292 nb_reaction_3 = nb_reaction_3 + 1 … … 3197 3297 ! mills, phd, 1998 3198 3298 3199 f027(:) = 1.3 d-34*exp(940./t(:))*conc(:)3299 f027(:) = 1.3E-34*exp(940./t(:))*conc(:) 3200 3300 3201 3301 nb_reaction_4 = nb_reaction_4 + 1 … … 3206 3306 ! mills, phd, 1998 3207 3307 3208 f028(:) = 1.0 d-113308 f028(:) = 1.0E-11 3209 3309 3210 3310 nb_reaction_4 = nb_reaction_4 + 1 … … 3215 3315 ! mills, phd, 1998 3216 3316 3217 f029(:) = 1.0 d-113317 f029(:) = 1.0E-11 3218 3318 3219 3319 nb_reaction_4 = nb_reaction_4 + 1 … … 3224 3324 ! moses et al. 2002 3225 3325 3226 f030(:) = 5.0 d-133326 f030(:) = 5.0E-13 3227 3327 3228 3328 nb_reaction_3 = nb_reaction_3 + 1 … … 3233 3333 ! yung and demore, 1999 (estimated) 3234 3334 3235 f031(:) = 5.0 d-32*conc(:)3335 f031(:) = 5.0E-32*conc(:) 3236 3336 3237 3337 nb_reaction_4 = nb_reaction_4 + 1 … … 3242 3342 ! mills, phd, 1998 3243 3343 3244 f032(:) = 7.4 d-12*exp(-1650./t(:))3344 f032(:) = 7.4E-12*exp(-1650./t(:)) 3245 3345 3246 3346 nb_reaction_4 = nb_reaction_4 + 1 … … 3251 3351 ! mills, phd, 1998 3252 3352 3253 f033(:) = 1.5 d-103353 f033(:) = 1.5E-10 3254 3354 3255 3355 nb_reaction_4 = nb_reaction_4 + 1 … … 3260 3360 ! jpl 2011 3261 3361 3262 f034(:) = 2.6 d-12*exp(-1100./t(:))3362 f034(:) = 2.6E-12*exp(-1100./t(:)) 3263 3363 3264 3364 nb_reaction_4 = nb_reaction_4 + 1 … … 3269 3369 ! yung and demore, 1982 3270 3370 3271 f035(:) = 3.0 d-123371 f035(:) = 3.0E-12 3272 3372 3273 3373 nb_reaction_4 = nb_reaction_4 + 1 … … 3278 3378 ! ohta, bull. chem. soc. jpn., 1983 3279 3379 3280 f036(:) = 6.45 d-2*f015(:)3380 f036(:) = 6.45E-2*f015(:) 3281 3381 3282 3382 nb_reaction_4 = nb_reaction_4 + 1 … … 3287 3387 ! mills, phd, 1998 3288 3388 3289 f037(:) = 1.5 d-11*exp(-1750./t(:))3389 f037(:) = 1.5E-11*exp(-1750./t(:)) 3290 3390 3291 3391 nb_reaction_4 = nb_reaction_4 + 1 … … 3296 3396 ! yung and demore, 1982 3297 3397 3298 f038(:) = 1.0 d-113398 f038(:) = 1.0E-11 3299 3399 3300 3400 nb_reaction_4 = nb_reaction_4 + 1 … … 3305 3405 ! yung and demore, 1982 (estimate) 3306 3406 3307 f039(:) = 1.0 d-32*conc(:)3407 f039(:) = 1.0E-32*conc(:) 3308 3408 3309 3409 nb_reaction_4 = nb_reaction_4 + 1 … … 3316 3416 !--- g001: s + o2 -> so + o 3317 3417 3318 g001(:) = 2.3 d-123418 g001(:) = 2.3E-12 3319 3419 3320 3420 nb_reaction_4 = nb_reaction_4 + 1 … … 3323 3423 !--- g002: s + o3 -> so + o2 3324 3424 3325 g002(:) = 1.2 d-113425 g002(:) = 1.2E-11 3326 3426 3327 3427 nb_reaction_4 = nb_reaction_4 + 1 … … 3330 3430 !--- g003: so + o2 -> so2 + o 3331 3431 3332 g003(:) = 1.25 d-13*exp(-2190./t(:))3432 g003(:) = 1.25E-13*exp(-2190./t(:)) 3333 3433 3334 3434 nb_reaction_4 = nb_reaction_4 + 1 … … 3337 3437 !--- g004: so + o3 -> so2 + o2 3338 3438 3339 g004(:) = 3.4 d-12*exp(-1100./t(:))3439 g004(:) = 3.4E-12*exp(-1100./t(:)) 3340 3440 3341 3441 nb_reaction_4 = nb_reaction_4 + 1 … … 3344 3444 !--- g005: so + oh -> so2 + h 3345 3445 3346 g005(:) = 2.7 d-11*exp(335./t(:))3446 g005(:) = 2.7E-11*exp(335./t(:)) 3347 3447 3348 3448 nb_reaction_4 = nb_reaction_4 + 1 … … 3351 3451 !--- g006: s + oh -> so + h 3352 3452 3353 g006(:) = 6.6 d-113453 g006(:) = 6.6E-11 3354 3454 3355 3455 nb_reaction_4 = nb_reaction_4 + 1 … … 3362 3462 3363 3463 do iz = 1,nz 3364 ak0 = 4.2 d-303365 ak1 = 5.3 d-113464 ak0 = 4.2E-30 3465 ak1 = 5.3E-11 3366 3466 3367 3467 rate = (ak0*conc(iz))/(1. + ak0*conc(iz)/ak1) … … 3375 3475 !--- g008: so + ho2 -> so2 + oh 3376 3476 3377 g008(:) = 2.8 d-113477 g008(:) = 2.8E-11 3378 3478 3379 3479 nb_reaction_4 = nb_reaction_4 + 1 … … 3383 3483 3384 3484 ! jpl 2011 3485 ! Naido 2005 3486 3487 ! do iz = 1,nz 3488 ! ak0 = 2.5*1.8E-33*(t(iz)/300.)**(2.0) 3489 ! ak1 = 4.2E-14*(t(iz)/300.)**(1.8) 3490 3491 ! rate = (ak0*conc(iz))/(1. + ak0*conc(iz)/ak1) 3492 ! xpo = 1./(1. + alog10((ak0*conc(iz))/ak1)**2) 3493 ! g009(iz) = rate*0.6**xpo 3494 ! g009(iz) = 0.0E+0 3495 ! end do 3385 3496 3386 3497 do iz = 1,nz 3387 ak0 = 2.5*1.8d-33*(t(iz)/300.)**(2.0) 3388 ak1 = 4.2d-14*(t(iz)/300.)**(1.8) 3389 3498 ak0 = 5.*9.5*1.E-23*(t(iz)**(-3.0))*EXP(-2400./t(iz)) 3499 ak1 = 6.1*1.E-13*EXP(-850./t(iz)) 3390 3500 rate = (ak0*conc(iz))/(1. + ak0*conc(iz)/ak1) 3391 3501 xpo = 1./(1. + alog10((ak0*conc(iz))/ak1)**2) 3392 g009(iz) = rate*0.6**xpo 3502 fc = 0.558*EXP(-t(iz)/316.)+0.442*EXP(-t(iz)/7442.) 3503 g009(iz) = rate*fc**xpo 3504 ! g009(iz) = 0.0E+0 3393 3505 end do 3394 3506 … … 3400 3512 ! zhang et al., icarus, 2011 3401 3513 3402 g010(:) = 1.5 d-34*exp(900./t(:))*conc(:)3514 g010(:) = 1.5E-34*exp(900./t(:))*conc(:) 3403 3515 3404 3516 nb_reaction_4 = nb_reaction_4 + 1 3405 3517 v_4(:,nb_reaction_4) = g010(:) 3406 3518 3407 !--- g011: so3 + h2o -> h2so4 3408 3519 !--- g011: so3 + h2o + M -> h2so4 + M 3520 !--- avec M = h2o 3521 3522 DO iz=1,nz 3409 3523 ! jpl 2011 3410 3411 ! g011(:) = 8.5d-21*exp(6540./t(:))*c(:,i_h2o) 3412 g011(:) = 2.26d-23*t(:)*exp(6540/t(:))*c(:,i_h2o)3413 g011( :) = g011(:)*1.d-203524 ! g011(:) = 8.5E-21*exp(6540./t(:))*c(:,i_h2o) 3525 g011(iz) = 2.26E-23*MAX(t(iz),100.)*exp(6540./MAX(t(iz),100.)) & 3526 *c(iz,i_h2o) 3527 g011(iz) = g011(iz)*1.0E-20 3414 3528 ! g011(:) = 0. ! SANS H2SO4 3529 ENDDO 3415 3530 3416 3531 nb_reaction_4 = nb_reaction_4 + 1 … … 3421 3536 ! jpl 2011 3422 3537 3423 g012(:) = 2.8 d-113538 g012(:) = 2.8E-11 3424 3539 3425 3540 nb_reaction_4 = nb_reaction_4 + 1 … … 3430 3545 ! chung et al., int. j. chem. kinet., 1975 3431 3546 3432 g013(:) = 2.0 d-153547 g013(:) = 2.0E-15 3433 3548 3434 3549 nb_reaction_4 = nb_reaction_4 + 1 … … 3439 3554 ! jacob and winkler, j. chem. soc. faraday trans. 1, 1972 3440 3555 3441 g014(:) = 2.32 d-16*exp(-487./t(:))3556 g014(:) = 2.32E-16*exp(-487./t(:)) 3442 3557 3443 3558 nb_reaction_4 = nb_reaction_4 + 1 … … 3449 3564 3450 3565 do iz = 1,nz 3451 ak0 = 2.5*4.4 d-313452 ak1 = 1.0 d-113566 ak0 = 2.5*4.4E-31 3567 ak1 = 1.0E-11 3453 3568 3454 3569 rate = (ak0*conc(iz))/(1. + ak0*conc(iz)/ak1) … … 3464 3579 ! mills, phd, 1998 3465 3580 3466 deq(:) = 2.5*1.0 d-28*exp(6000./t(:))3581 deq(:) = 2.5*1.0E-28*exp(6000./t(:)) 3467 3582 3468 3583 g016(:) = g015(:)/(deq(:)*conc(:)) … … 3479 3594 ! 0.5 clco3 + 0.5 so -> so2 + co2 3480 3595 3481 g017(:) = 1.0 d-113596 g017(:) = 1.0E-11 3482 3597 3483 3598 nb_reaction_4 = nb_reaction_4 + 1 … … 3491 3606 ! zhang et al., icarus, 2011 (estimate?) 3492 3607 3493 g018(:) = 2.5*4.0d-33*exp(-1940./t(:))*conc(:) 3608 g018(:) = 2.5*4.0E-33*exp(-1940./t(:))*conc(:) 3609 3610 ! g018(:) = 0.0E+0 3494 3611 3495 3612 nb_reaction_4 = nb_reaction_4 + 1 … … 3500 3617 ! zhang et al., icarus, 2011 3501 3618 3502 g019(:) = 3.0d-12 3619 g019(:) = 3.0E-12 3620 3621 ! g019(:) = 0.0E+0 3503 3622 3504 3623 nb_reaction_4 = nb_reaction_4 + 1 … … 3510 3629 3511 3630 do iz = 1,nz 3512 ak0 = 2.5*3.3 d-31*(t(iz)/300.)**(-4.3)3513 ak1 = 1.6 d-123631 ak0 = 2.5*3.3E-31*(t(iz)/300.)**(-4.3) 3632 ak1 = 1.6E-12 3514 3633 3515 3634 rate = (ak0*conc(iz))/(1. + ak0*conc(iz)/ak1) … … 3525 3644 ! jpl 2011 3526 3645 3527 g021(:) = 1.3 d-12*exp(-330./t(:))3646 g021(:) = 1.3E-12*exp(-330./t(:)) 3528 3647 3529 3648 nb_reaction_4 = nb_reaction_4 + 1 … … 3535 3654 3536 3655 do iz = 1,nz 3537 ak0 = 1.19 d-293538 ak1 = 1.0 d-103656 ak0 = 1.19E-29 3657 ak1 = 1.0E-10 3539 3658 3540 3659 rate = (ak0*conc(iz))/(1. + ak0*conc(iz)/ak1) … … 3550 3669 ! chase et al., 1985 3551 3670 3552 ! deq(:) = 2.68 d-25*exp(50860./t(:))3671 ! deq(:) = 2.68E-25*exp(50860./t(:)) 3553 3672 3554 3673 ! g023(:) = g022(:)/(deq(:)*conc(:)) … … 3560 3679 ! Pas encore inclu dans la table jphot 3561 3680 3562 g023(:) = 6.5d-3 3563 3681 ! Pas de photodissociation sous le nuage photochimique 3682 g023(1:28) = 0.0E+0 3683 3684 ! Dependance en sza pour la photodissociation 3685 ! moins de W.m-2 3686 IF (sza_input.LT.90.0) THEN 3687 g023(29:50) = 6.5E-3*COS(sza_input*pi/180.0) 3688 ELSE 3689 g023(29:50) = 0.0E+0 3690 END IF 3691 3564 3692 nb_phot = nb_phot + 1 3565 3693 3566 IF (sza_input.LE.95.0) THEN3567 3694 v_phot(:,nb_phot) = g023(:) 3568 ELSE3569 v_phot(:,nb_phot) = 0.0d03570 END IF3571 3695 3572 3696 !--- g024: s2 + o -> so + s … … 3574 3698 ! zhang et al., icarus, 2011 3575 3699 3576 g024(:) = 2.2 d-11*exp(-84./t(:))3700 g024(:) = 2.2E-11*exp(-84./t(:)) 3577 3701 3578 3702 nb_reaction_4 = nb_reaction_4 + 1 … … 3583 3707 ! lu et al., j. chem. phys., 2006 3584 3708 3585 g025(:) = 6.63d-20*(t(:)**2.57)*exp(-1180./t(:)) 3709 g025(:) = 6.63E-20*(t(:)**2.57)*exp(-1180./t(:)) 3710 3711 ! g025(:) = 0.0E+0 3586 3712 3587 3713 nb_reaction_4 = nb_reaction_4 + 1 … … 3592 3718 ! atkinson et al., 2004 3593 3719 3594 g026(:) = 1.60 d-11*exp(-2150./t(:))3720 g026(:) = 1.60E-11*exp(-2150./t(:)) 3595 3721 3596 3722 nb_reaction_4 = nb_reaction_4 + 1 … … 3601 3727 ! moses et al., 2002 3602 3728 3603 g027(:) = 1.0 d-163729 g027(:) = 1.0E-16 3604 3730 3605 3731 nb_reaction_4 = nb_reaction_4 + 1 … … 3610 3736 ! yung and demore, 1982 3611 3737 3612 g028(:) = 3.0 d-11*exp(200./t(:))3738 g028(:) = 3.0E-11*exp(200./t(:)) 3613 3739 3614 3740 nb_reaction_4 = nb_reaction_4 + 1 … … 3619 3745 ! moses et al., 2002 3620 3746 3621 g029(:) = 4.0 d-113747 g029(:) = 4.0E-11 3622 3748 3623 3749 nb_reaction_4 = nb_reaction_4 + 1 … … 3628 3754 ! krasnopolsky , 2007 3629 3755 3630 g030(:) = 7.0d-14*exp(-5170./t(:)) 3631 ! g030(:) = 0.0d0 3756 g030(:) = 7.0E-14*exp(-5170./t(:)) 3757 3758 ! g030(:) = g011(:)/(deq(:)*c(:,i_h2o)) 3759 ! g030(:) = 0.0E+0 3632 3760 3633 3761 nb_phot = nb_phot + 1 3634 3762 v_phot(:,nb_phot) = g030(:)*c(:,i_h2o) 3763 ! v_phot(:,nb_phot) = 0.0E+0 3635 3764 3636 3765 !--- g031: so3 + ocs -> s2o2 + co2 … … 3638 3767 ! krasnopolsky , 2007 3639 3768 3640 g031(:) = 1.0 d-11*exp(-10000./t(:))3641 ! g031(:) = 0.0 d03769 g031(:) = 1.0E-11*exp(-10000./t(:)) 3770 ! g031(:) = 0.0E+0 3642 3771 3643 3772 nb_reaction_4 = nb_reaction_4 + 1 … … 3652 3781 ! krasnopolsky , 2007 3653 3782 3654 g032(:) = 1.0 d-203655 ! g032(:) = 0.0 d03783 g032(:) = 1.0E-20 3784 ! g032(:) = 0.0E+0 3656 3785 3657 3786 nb_reaction_4 = nb_reaction_4 + 1 … … 3664 3793 ! Krasnopolsky 2012 from Martinez & Heron 1983 or Moses et al 2002 3665 3794 3666 ! g033(:) = 3.5 d-153667 g033(:) =1.0 d-12*exp(-1700.0/t(:))3795 ! g033(:) = 3.5E-15 3796 g033(:) =1.0E-12*exp(-1700.0/t(:)) 3668 3797 3669 3798 nb_reaction_3 = nb_reaction_3 + 1 … … 3684 3813 3685 3814 gam = 0.025 3686 h001(:) = surfice1d(:)*1. d-8 &3687 *100.*sqrt(8.*8.31*t(:)/(33. d-3*pi))*gam/4.3815 h001(:) = surfice1d(:)*1.E-8 & 3816 *100.*sqrt(8.*8.31*t(:)/(33.E-3*pi))*gam/4. 3688 3817 3689 3818 ! h002: oh + ice -> products … … 3692 3821 3693 3822 gam = 0.03 3694 h002(:) = surfice1d(:)*1. d-8 &3695 *100.*sqrt(8.*8.31*t(:)/(17. d-3*pi))*gam/4.3823 h002(:) = surfice1d(:)*1.E-8 & 3824 *100.*sqrt(8.*8.31*t(:)/(17.E-3*pi))*gam/4. 3696 3825 3697 3826 !--- h003: h2o2 + ice -> products … … 3700 3829 3701 3830 gam = 0. 3702 h003(:) = surfice1d(:)*1. d-8 &3703 *100.*sqrt(8.*8.31*t(:)/(34. d-3*pi))*gam/4.3831 h003(:) = surfice1d(:)*1.E-8 & 3832 *100.*sqrt(8.*8.31*t(:)/(34.E-3*pi))*gam/4. 3704 3833 else 3705 3834 h001(:) = 0. … … 3730 3859 3731 3860 gam = 0.2 3732 h004(:) = surfdust1d(:)*1. d-8 &3733 *100.*sqrt(8.*8.31*t(:)/(33. d-3*pi))*gam/4.3861 h004(:) = surfdust1d(:)*1.E-8 & 3862 *100.*sqrt(8.*8.31*t(:)/(33.E-3*pi))*gam/4. 3734 3863 3735 3864 !--- h005: h2o2 + dust -> products 3736 3865 3737 ! gamma = 5. d-43866 ! gamma = 5.E-4 3738 3867 ! see dereus et al., atm. chem. phys., 2005 3739 3868 3740 gam = 5. d-43741 h005(:) = surfdust1d(:)*1. d-8 &3742 *100.*sqrt(8.*8.31*t(:)/(34. d-3*pi))*gam/4.3869 gam = 5.E-4 3870 h005(:) = surfdust1d(:)*1.E-8 & 3871 *100.*sqrt(8.*8.31*t(:)/(34.E-3*pi))*gam/4. 3743 3872 else 3744 3873 h004(:) = 0. … … 3765 3894 ! Krasnopolsky (2010a) 3766 3895 3767 i001(:) = 1. d-203896 i001(:) = 1.E-20 3768 3897 3769 3898 nb_phot = nb_phot + 1 … … 3774 3903 ! Lafferty et al; (1998) 3775 3904 3776 i002(:) = 2.2 d-43905 i002(:) = 2.2E-4 3777 3906 3778 3907 nb_phot = nb_phot + 1 … … 3793 3922 3794 3923 integer :: i4, iz, nb_reaction_4 3795 real :: ep = 1. d-33924 real :: ep = 1.E-3 3796 3925 integer, INTENT(IN) :: nz, nesp, nb_reaction_4_max 3797 double precision, dimension(nb_reaction_4_max), INTENT(OUT) :: eps_43926 real, dimension(nb_reaction_4_max), INTENT(OUT) :: eps_4 3798 3927 3799 3928 ! number densities 3800 3929 3801 double precision, dimension(nz,nesp) :: c3930 real, dimension(nz,nesp) :: c 3802 3931 3803 3932 nb_reaction_4 = 0 … … 4574 4703 4575 4704 do i4 = 1,nb_reaction_4 4576 eps_4(i4) = max(eps_4(i4), 0. d0)4577 eps_4(i4) = min(eps_4(i4), 1. d0)4705 eps_4(i4) = max(eps_4(i4), 0.E+0) 4706 eps_4(i4) = min(eps_4(i4), 1.E+0) 4578 4707 end do 4579 4708 … … 4601 4730 integer :: iphot,i3,i4 4602 4731 4603 double precision:: Xphot_11,Xphot_21,Xphot_314604 double precision:: X3_11,X3_21,X3_314605 double precision:: X4_11,X4_12,X4_21,X4_22,X4_31,X4_32,X4_41,X4_424732 real :: Xphot_11,Xphot_21,Xphot_31 4733 real :: X3_11,X3_21,X3_31 4734 real :: X4_11,X4_12,X4_21,X4_22,X4_31,X4_32,X4_41,X4_42 4606 4735 real, INTENT(IN) :: dtx 4607 4736 4608 double precision, INTENT(IN), dimension(nz,nesp) :: c4737 real, INTENT(IN), dimension(nz,nesp) :: c 4609 4738 4610 4739 ! matrix 4611 4740 4612 double precision, dimension(nesp,nesp), INTENT(OUT) :: mat4613 ! double precision:: d4741 real, dimension(nesp,nesp), INTENT(OUT) :: mat 4742 !real :: d 4614 4743 !integer :: code 4615 4744 !integer, dimension(nesp) :: indx … … 4621 4750 real, dimension(6*nb_reaction_3_max), INTENT(IN) :: indice_3 4622 4751 real, dimension(8*nb_reaction_4_max), INTENT(IN) :: indice_4 4623 double precision, dimension(nz, nb_phot_max), INTENT(IN) :: v_phot4624 double precision, dimension(nz, nb_reaction_3_max), INTENT(IN) :: v_34625 double precision, dimension(nz, nb_reaction_4_max), INTENT(IN) :: v_44626 double precision, dimension(nb_reaction_4_max), INTENT(IN) :: eps_44752 real, dimension(nz, nb_phot_max), INTENT(IN) :: v_phot 4753 real, dimension(nz, nb_reaction_3_max), INTENT(IN) :: v_3 4754 real, dimension(nz, nb_reaction_4_max), INTENT(IN) :: v_4 4755 real, dimension(nb_reaction_4_max), INTENT(IN) :: eps_4 4627 4756 4628 4757 ! initialisation … … 4739 4868 integer, parameter :: nb_reaction_4_max = 84 4740 4869 4741 double precision, dimension(n_lev,nb_phot_max) :: vphot4742 double precision, dimension(n_lev,nb_reaction_3_max) :: v34743 double precision, dimension(n_lev,nb_reaction_4_max) :: v44870 real, dimension(n_lev,nb_phot_max) :: vphot 4871 real, dimension(n_lev,nb_reaction_3_max) :: v3 4872 real, dimension(n_lev,nb_reaction_4_max) :: v4 4744 4873 4745 4874 !PRINT*,"DEBUT subroutine rate_save" … … 4802 4931 4803 4932 DO i_lev=1, n_lev 4804 concentration(i_lev) = pres(i_lev)/(1.3806488 d-19 * temperature(i_lev))4933 concentration(i_lev) = pres(i_lev)/(1.3806488E-19 * temperature(i_lev)) 4805 4934 END DO 4806 4935 -
trunk/LMDZ.VENUS/libf/phyvenus/nirco2abs.F
r1310 r1442 1 1 SUBROUTINE nirco2abs(nlon,nlev,nplay,dist_sol,nq,pq, 2 $ mu0,fract,pdtnirco2, 3 $ co2vmr_gcm, ovmr_gcm) 2 $ mu0,fract,pdtnirco2) 4 3 5 4 use dimphy 6 5 use comgeomphy, only: rlatd, rlond 6 use chemparam_mod, only: i_co2, i_o 7 7 c use compo_hedin83_mod2 8 8 … … 23 23 c Stephen Lewis 2000 24 24 c 25 C jan 2014 g.gilli 25 c oct 2014 g.gilli Coupling with photochemical model 26 C jan 2014 g.gilli Revision (following martian non-lte param) 26 27 C jun 2013 l.salmi First adaptation to Venus and NIR NLTE param 27 28 c jul 2011 malv+fgg New corrections for NLTE implemented … … 59 60 #include "nirdata.h" 60 61 c#include "tracer.h" 61 62 #include "mmol.h" 62 63 c----------------------------------------------------------------------- 63 64 c Input/Output 64 65 c ------------ 65 66 integer,intent(in) :: nlon ! number of (horizontal) grid points 66 67 67 integer,intent(in) :: nlev ! number of atmospheric layers 68 68 69 real,intent(in) :: nplay(nlon,nlev) ! Pressure 69 70 real,intent(in) :: dist_sol ! Sun-Venus distance (in AU) 70 71 integer,intent(in) :: nq ! number of tracers 71 real,intent(in) :: pq(nlon,nlev,nq) ! tracers72 real,intent(in) :: pq(nlon,nlev,nq) ! mass mixing ratio tracers 72 73 real,intent(in) :: mu0(nlon) ! solar angle 73 74 real,intent(in) :: fract(nlon) ! day fraction of the time interval 74 75 c real,intent(in) :: declin ! latitude of sub-solar point 75 76 real co2vmr_gcm(nlon,nlev),ovmr_gcm(nlon,nlev) 77 76 real :: co2vmr_gcm(nlon,nlev), o3pvmr_gcm(nlon,nlev) 77 78 78 real,intent(out) :: pdtnirco2(nlon,nlev) ! heating rate (K/sec) 79 79 … … 95 95 integer,save :: io=0 ! index of "o" tracer 96 96 97 ccc 97 cccc parameters for CO2 heating fit 98 98 c 99 99 c n_a = heating rate for Venusian day at p0, r0, mu =0 [K day-1] … … 104 104 real n_a, n_p0, n_b, p_ctop 105 105 106 cc Current values 107 parameter (n_a = 18.13/86400.0) !! K/Eday ---> K/sec 106 107 cc "Nominal" values 108 parameter (n_a = 18.13/86400.0) !c K/Eday ---> K/sec 108 109 parameter (p_ctop=13.2e2) 110 c -- NLTE Param v3 -- 111 parameter (n_p0=0.008) 112 parameter (n_b=1.362) 113 114 cc -- Varoxy5 115 C parameter (n_a = 20/86400.0) 116 C parameter (p_ctop=870) ! [Pa] 117 C parameter (n_b=1.98) 118 C parameter (n_p0=0.045) 119 120 c parameter (n_p0=0.1) !!!!cccc test varoxy5mod 121 c parameter (n_b=0.9) 122 109 123 110 124 c -- NLTE Param v2 -- 111 cparameter (n_p0=0.01)125 C parameter (n_p0=0.01) 112 126 c parameter (n_b = 1.3) 113 114 ccc TESTS 115 c parameter (n_a = 18.4/86400.0 *0.6) 116 c parameter (p_ctop=63.9e2) 117 c parameter (n_p0=0.012) 118 c parameter (n_b=1.9628251) 119 120 121 c -- NLTE Param v1 -- 122 c parameter (n_p0=0.012) 123 c parameter (n_b = 1.4) 124 125 c -- NLTE Param v3 -- 126 127 parameter (n_p0=0.008) 128 parameter (n_b = 1.362) 127 129 128 130 129 … … 134 133 real p2011,cociente1,merge 135 134 real cor0,oco2gcm 136 137 c co2heat is the heating by CO2 at p_ctop=9.3E03 Pa (cloud top 65 km) for a zero zenithal angle. 135 !!!! 136 c real :: pic27(nlon,nlev), pic27b(nlon,nlev) 137 c real :: pic43(nlon,nlev), picnir(nlon,nlev) 138 139 c co2heat is the heating by CO2 at p_ctop=13.2e2 for a zero zenithal angle. 138 140 139 141 co2heat0=n_a*(0.72/dist_sol)**2 140 142 141 142 CCCCCC TEST: reduce/incrise by 50% nir Heating 143 144 c co2heat0 = co2heat0 * 2 143 CCCCCC TEST: reduce by X% nir Heating 144 145 c co2heat0 = co2heat0 * 0.8 145 146 146 147 … … 149 150 c Initialisation 150 151 c -------------- 151 cif (firstcall) then152 cif (nircorr.eq.1) then153 c c! we will need co2 and o tracers154 c ico2= igcm_co2155 cif (ico2==0) then156 cwrite(*,*) "nirco2abs error: I need a CO2 tracer"157 cwrite(*,*) " when running with nircorr==1"158 cstop159 cendif160 c io=igcm_o161 cif (io==0) then162 cwrite(*,*) "nirco2abs error: I need an O tracer"163 cwrite(*,*) " when running with nircorr==1"164 cstop165 cendif166 cendif167 cfirstcall=.false.168 cendif152 if (firstcall) then 153 if (nircorr.eq.1) then 154 c ! we will need co2 and o tracers 155 ico2= i_co2 156 if (ico2==0) then 157 write(*,*) "nirco2abs error: I need a CO2 tracer" 158 write(*,*) " when running with nircorr==1" 159 stop 160 endif 161 io=i_o 162 if (io==0) then 163 write(*,*) "nirco2abs error: I need an O tracer" 164 write(*,*) " when running with nircorr==1" 165 stop 166 endif 167 endif 168 firstcall=.false. 169 endif 169 170 170 171 … … 178 179 zmu(ig)=sqrt(1224.*mu0(ig)*mu0(ig)+1.)/35. 179 180 180 181 181 182 if(nircorr.eq.1) then 182 183 do l=1,nlev … … 187 188 call interpnir(oldoco2,pyy,nlev,oco21d,pres1d,npres) 188 189 call interpnir(alfa2,pyy,nlev,alfa,pres1d,npres) 189 190 190 191 endif 191 192 192 193 do l=1,nlev 194 193 195 c Calculations for the O/CO2 correction 194 196 if(nircorr.eq.1) then 195 197 cor0=1./(1.+n_p0/nplay(ig,l))**n_b 196 if(co2vmr_gcm(ig,l).gt.1.e-6) then 197 oco2gcm=ovmr_gcm(ig,l)/co2vmr_gcm(ig,l) 198 if(pq(ig,l,ico2) .gt. 1.e-6) then 199 oco2gcm=pq(ig,l,io)/pq(ig,l,ico2) 200 198 201 else 199 202 oco2gcm=1.e6 200 203 endif 201 204 cociente1=oco2gcm/oldoco2(l) 205 206 c WRITE(*,*) "nirco2abs line 211", l, cociente1 207 202 208 merge=alog10(cociente1)*alfa2(l)+alog10(cor0)* 203 209 $ (1.-alfa2(l)) … … 209 215 cor1(l)=1. 210 216 endif 211 212 217 213 218 if(fract(ig).gt.0.) pdtnirco2(ig,l)= … … 216 221 c Corrections from tabulation 217 222 $ * cor1(l) * p2011 218 219 223 220 224 enddo 221 225 enddo … … 250 254 251 255 do l=1,nlev 252 if(nircorr.eq.1) then253 cor0=1./(1.+n_p0/nplay(ig,l))**n_b254 c oco2gcm=ovmr_gcm(ig,l)/co2vmr_gcm(ig,l) 255 cociente1 = 1256 merge=alog10(cociente1)*alfa2(l)+alog10(cor0)*257 $ (1.-alfa2(l))258 merge=10**merge259 p2011=sqrt(merge)*cor0260 else if (nircorr.eq.0) then261 p2011=1. 262 cor1(l)=1.263 endif264 265 c 266 267 268 & 269 & 270 & 271 ! 272 $ 256 c Calculations for the O/CO2 correction 257 if(nircorr.eq.1) then 258 cor0=1./(1.+n_p0/nplay(ig,l))**n_b 259 oco2gcm=pq(ig,l,io)/pq(ig,l,ico2) 260 cociente1=oco2gcm/oldoco2(l) 261 merge=alog10(cociente1)*alfa2(l)+alog10(cor0)* 262 $ (1.-alfa2(l)) 263 merge=10**merge 264 p2011=sqrt(merge)*cor0 265 266 else if (nircorr.eq.0) then 267 p2011=1. 268 cor1(l)=1. 269 endif 270 271 if(fract_int(ig).gt.0.) pdtnirco2(ig,l)= 272 & pdtnirco2(ig,l) + (1/float(nstep))* 273 & co2heat0*sqrt((p_ctop*zmu(ig))/nplay(ig,l)) 274 & /(1.+n_p0/nplay(ig,l))**n_b 275 ! Corrections from tabulation 276 $ * cor1(l) * p2011 273 277 274 278 enddo … … 276 280 end do 277 281 278 END IF 282 283 END IF 279 284 280 285 return 281 286 end 282 283 287 284 288 … … 294 298 do n1=1,nlev 295 299 if(p(n1) .gt. 1500. .or. p(n1) .lt. 1.0e-13) then 296 escout(n1) = 0.0 300 c escout(n1) = 0.0 301 escout(n1) = 1.e-15 297 302 else 298 303 do n = 1,nl-1 -
trunk/LMDZ.VENUS/libf/phyvenus/nlte_setup.F
r1310 r1442 178 178 179 179 k20x = 3.d-12 180 c TEST GG: double the values of Kvv as recently found by Sharma et al.2014 181 c k20x = 6.d-12 182 c TEST GG: use the minimum value of the experimental bracket's values [1-6] 183 c k20x = 1.d-12 180 184 k20xc = k20x * rf20 181 185 k20xb = 2.d0 * k20xc … … 189 193 k19xcc = k19xcb 190 194 191 ccc test gab cccc !!!!! <---------------------------------------192 195 factor = 2.5d0 193 c factor = 3.5d0194 195 196 k19xba = factor * k19xca 196 197 k19xbb = factor * k19xcb … … 231 232 232 233 k21x = 2.49d-11 234 CCC TEST GG 235 c k21x = 2.49d-11*0.5 236 C k21x = 2.49d-11*2 237 233 238 k21xb = k21x 234 239 k21xa = 3.d0/2.d0 * k21xb -
trunk/LMDZ.VENUS/libf/phyvenus/nlte_tcool.F
r1310 r1442 33 33 implicit none 34 34 35 #include "dimensions.h"36 #include "nlte_paramdef.h"37 #include "nlte_commons.h"38 #include "YOMCST.h"35 include "dimensions.h" 36 include "nlte_paramdef.h" 37 include "nlte_commons.h" 38 include "YOMCST.h" 39 39 40 40 c Arguments … … 48 48 real q15umco2_gcm(nlon,nlev) ! is in K/RDAY (see hrkday_convert) 49 49 ! but converted to K/s (see CONVERSION_KDAY_Ksec ) 50 ! real auxgcm(nlev)51 50 real*8 auxgcmd(nlev), aux2gcmd(nlev) 52 51 real zmin_gcm 53 52 integer ierr 54 53 real*8 varerr 55 56 57 54 58 55 c local variables and constants … … 66 63 real co2_ig(nlev),n2_ig(nlev),co_ig(nlev),o3p_ig(nlev) 67 64 real mmean_ig(nlev),cpnew_ig(nlev) 68 !!!!!69 c real cpnew(nlon,nlev)70 c real rnew(nlon,nlev)71 c real mmean(nlon,nlev)72 73 65 74 66 … … 90 82 mmean_ig(l)=mmean(ig,l) 91 83 cpnew_ig(l)=cpnew(ig,l) 84 92 85 enddo 93 86 … … 318 311 ! print*, zl 319 312 320 321 322 call interhunt ( pl,zl,nl, 313 ! Creamos el perfil del NLTE modelo completo interpolando 314 315 call interhunt ( pl,zl,nl, p_gcm,z_gcm,nlev, 2) ! [atm] 323 316 call interhunt5veces 324 317 $ ( t, co2vmr, n2vmr, covmr, o3pvmr, … … 354 347 write (*,*) ' i, t(i), pl(i) =', i, t(i), pl(i) 355 348 endif 356 if (t(i) .lt. 20.0) then349 if (t(i) .lt. 50.0) then 357 350 write (*,*) '!!!! WARNING Temp lower than Histogram.' 358 351 write (*,*) ' Histogram will be extrapolated. ' -
trunk/LMDZ.VENUS/libf/phyvenus/physiq.F
r1310 r1442 64 64 USE write_field_phy 65 65 USE iophy 66 usecpdet_mod, only: cpdet, t2tpot66 USE cpdet_mod, only: cpdet, t2tpot 67 67 USE chemparam_mod 68 68 USE conc … … 240 240 EXTERNAL conduction 241 241 EXTERNAL molvis 242 EXTERNAL moldiff_red 243 242 244 c 243 245 c Variables locales … … 260 262 REAL zdtime, zlongi 261 263 c 262 INTEGER i, k, iq, ig, j, ll 264 INTEGER i, k, iq, ig, j, ll, ilon, ilat, ilev 263 265 c 264 266 REAL zphi(klon,klev) … … 301 303 real d_v_molvis(klon,klev) ! (m/s) /s 302 304 305 c Tendencies due to molecular diffusion 306 real d_q_moldif(klon,klev,nqmax) 307 303 308 c 304 309 c Variables liees a l'ecriture de la bande histoire physique … … 322 327 REAL :: tr_seri(klon,klev,nqmax) 323 328 REAL :: d_tr(klon,klev,nqmax) 329 330 c Champ de modification de la temperature par rapport a VIRAII 331 REAL delta_temp(klon,klev) 332 c SAVE delta_temp 333 REAL mat_dtemp(33,50) 334 SAVE mat_dtemp 324 335 325 336 c Variables tendance sedimentation … … 493 504 C TRACEURS 494 505 C source dans couche limite 495 source = 0.0 ! pas de source, pour l'instant506 source(:,:) = 0.0 ! pas de source, pour l'instant 496 507 c--------- 497 508 … … 510 521 rnew(ig,j)=R 511 522 cpnew(ig,j)=cpdet(tmoy(j)) 512 c print*, ' physique l503' 513 c print*, j, cpdet(tmoy(j)) 514 mmean(ig,j)=RMD 523 mmean(ig,j)=RMD 515 524 akknew(ig,j)=1.e-4 516 525 enddo … … 522 531 call compo_hedin83_init2 523 532 ENDIF 524 if (callnlte ) call nlte_setup525 if (callnirco2.and.(nircorr.eq.1)) call nir_leedat533 if (callnlte.and.nltemodel.eq.2) call nlte_setup 534 if (callnirco2.and.nircorr.eq.1) call nir_leedat 526 535 c--------- 527 536 … … 627 636 endif 628 637 629 if ((nlon .GT. 1) .AND. ok_chem) then638 if ((nlon .GT. 1) .AND. (ok_chem.OR.ok_cloud)) then 630 639 c !!! DONC 3D !!! 631 640 CALL chemparam_ini() … … 636 645 CALL cloud_ini(nlon,nlev) 637 646 endif 647 648 c====================================================================== 649 c Lecture du fichier DeltaT 650 c====================================================================== 651 652 c ATTENTION tout ce qui suit est pour un 48*32*50 653 654 if (ok_deltatemp) then 655 656 print*,'lecture de VenusDeltaT.txt ' 657 open(99, form = 'formatted', status = 'old', file = 658 & 'VenusDeltaT.dat') 659 print*,'Ouverture de VenusDeltaT.txt ' 660 661 DO ilev = 1, klev 662 read(99,'(33(1x,e13.6))') (mat_dtemp(ilat,ilev),ilat=1,33) 663 print*,'lecture de VenusDeltaT.txt ligne:',ilev 664 ENDDO 665 666 close(99) 667 print*,'FIN lecture de VenusDeltaT.txt ok.' 668 669 DO k = 1, klev 670 DO i = 1, klon 671 ilat=(rlatd(i)/5.625) + 17. 672 delta_temp(i,k)=mat_dtemp(INT(ilat),k) 673 ENDDO 674 ENDDO 675 676 endif 638 677 639 678 ENDIF ! debut 640 c==================================================================== 679 c====================================================================== 641 680 c====================================================================== 642 681 … … 830 869 ! Case 3: Full chemistry and/or clouds 831 870 832 call phytrac_chimie( 871 if (ok_deltatemp) then 872 ! PRINT*,'Def de delta_temp' 873 DO k = 1, klev 874 DO i = 1, klon 875 ilat=(rlatd(i)/5.625) + 17. 876 ! PRINT*,INT(ilat),rlatd(i),mat_dtemp(INT(ilat),k) 877 delta_temp(i,k)=mat_dtemp(INT(ilat),k) 878 ENDDO 879 ENDDO 880 881 endif 882 883 if (ok_deltatemp) then 884 ! Utilisation du champ de temperature modifie 885 call phytrac_chimie( 833 886 I debut, 834 887 I gmtime, 835 888 I nqmax, 836 I nlon,889 I klon, 837 890 I rlatd, 838 891 I rlond, 839 892 I nlev, 840 893 I dtime, 841 I t_seri,pplay, 842 O tr_seri, 843 O NBRTOT, 844 O WH2SO4, 845 O rho_droplet) 894 I t_seri+delta_temp, 895 I pplay, 896 O tr_seri) 897 else 898 899 call phytrac_chimie( 900 I debut, 901 I gmtime, 902 I nqmax, 903 I klon, 904 I rlatd, 905 I rlond, 906 I nlev, 907 I dtime, 908 I t_seri, 909 I pplay, 910 O tr_seri) 911 endif 846 912 847 913 c CALL WriteField_phy('Pression',pplay,nlev) … … 856 922 if (ok_sedim) then 857 923 924 if (ok_deltatemp) then 925 ! Utilisation du champ de temperature modifie 858 926 CALL new_cloud_sedim( 859 I klon, 860 I nlev, 861 I dtime, 862 I pplay, 863 I paprs, 864 I t_seri, 865 I WH2SO4, 866 I tr_seri, 867 I nqmax, 868 I NBRTOT, 869 I rho_droplet, 870 O Fsedim, 871 O d_tr_sed, 872 O d_tr_ssed) 873 874 DO k = 1, klev 875 DO i = 1, klon 876 877 c WRITE(88,"(11(e15.8,','))") pplay(5,25), 878 c & t_seri(5,25),tr_seri(5,25,i_h2oliq), 879 c & tr_seri(5,25,i_h2o),tr_seri(5,25,i_h2so4liq), 880 c & tr_seri(5,25,i_h2so4),NBRTOT(5,25),WH2SO4(5,25), 881 c & Fsedim(5,25),d_tr_sed(5,25,1),d_tr_sed(5,25,2) 927 I klon, 928 I nlev, 929 I dtime, 930 I pplay, 931 I paprs, 932 I t_seri+delta_temp, 933 I tr_seri, 934 O d_tr_sed, 935 O d_tr_ssed, 936 I nqmax, 937 O Fsedim) 938 else 939 940 CALL new_cloud_sedim( 941 I klon, 942 I nlev, 943 I dtime, 944 I pplay, 945 I paprs, 946 I t_seri, 947 I tr_seri, 948 O d_tr_sed, 949 O d_tr_ssed, 950 I nqmax, 951 O Fsedim) 952 953 endif 954 955 DO k = 1, klev 956 DO i = 1, klon 882 957 883 958 c-------------------- … … 888 963 PRINT*,'d_tr_sed Nan?',d_tr_sed(i,k,:),'Temp',t_seri(i,k) 889 964 PRINT*,'lat-lon',i,'level',k,'dtime',dtime 890 PRINT*,' NBRTOT',NBRTOT(i,k),'F_sed',Fsedim(i,k)965 PRINT*,'F_sed',Fsedim(i,k) 891 966 PRINT*,'===============================================' 892 967 d_tr_sed(i,k,:)=0. … … 901 976 Fsedim(i,k) = Fsedim(i,k) / dtime 902 977 903 ENDDO904 978 ENDDO 979 ENDDO 905 980 906 981 Fsedim(:,klev+1) = 0. … … 988 1063 ENDDO 989 1064 ENDDO 1065 990 1066 DO iq=1, nqmax 1067 c AS: changement 1068 c Pourquoi d_tr_vdf(1,1,iq) et tr_seri(1,1,iq) 1069 c et pas d_tr_vdf(:,:,iq) tr_seri(:,:,iq) 1070 c Je vois pas en quoi cltrac ne prendrait en compte que le traceur à la surface et au point 1 en klon 1071 c 1072 1073 c Je garde le source(:,iq) parce que je comprend pas sinon source 1074 c dimension(klon,nqmax) et flux dans cltrac (klon) ??? 1075 1076 c CALL cltrac(dtime,ycoefh,t_seri, 1077 c s tr_seri(1,1,iq),source(:,iq), 1078 c e paprs, pplay,delp, 1079 c s d_tr_vdf(1,1,iq)) 1080 991 1081 CALL cltrac(dtime,ycoefh,t_seri, 992 s tr_seri( 1,1,iq),source,1082 s tr_seri(:,:,iq),source(:,iq), 993 1083 e paprs, pplay,delp, 994 s d_tr_vdf(1,1,iq)) 1084 s d_tr_vdf(:,:,iq)) 1085 995 1086 tr_seri(:,:,iq) = tr_seri(:,:,iq) + d_tr_vdf(:,:,iq) 996 1087 d_tr_vdf(:,:,iq)= d_tr_vdf(:,:,iq)/dtime ! /s 1088 1089 DO k = 1, klev 1090 DO i = 1, klon 1091 tr_seri(i,k,iq) = tr_seri(i,k,iq) + d_tr_vdf(i,k,iq) 1092 d_tr_vdf(i,k,iq)= d_tr_vdf(i,k,iq)/dtime ! /s 997 1093 ENDDO 998 endif 1094 ENDDO 1095 1096 ENDDO !nqmax 1097 1098 endif 999 1099 1000 1100 IF (if_ebil.ge.2) THEN … … 1084 1184 d_tr_ajs(:,:,:)= d_tr_ajs(:,:,:)/dtime ! /s 1085 1185 endif 1086 1087 1186 endif 1088 1187 … … 1104 1203 END IF 1105 1204 1205 1106 1206 c==================================================================== 1107 1207 c RAYONNEMENT 1108 1208 c==================================================================== 1109 1209 1110 c------------------------------------ -----------------------------------1210 c------------------------------------ 1111 1211 c . Compute radiative tendencies : 1112 1212 c------------------------------------ … … 1118 1218 c PRINT*,'dtimerad,dtime,radpas',dtimerad,dtime,radpas 1119 1219 1120 c Calcul pour Cp rnew et mmean avec traceurs (Cp independant de T !! ) 1121 IF(callnlte.or.callthermos) THEN 1220 1221 c------------------------------------ 1222 c . Compute mean mass, cp and R : 1223 c------------------------------------ 1224 1225 if(callthermos) then 1226 call concentrations2(pplay,t_seri,d_t,tr_seri, nqmax, 1227 & pdtphys) 1228 1229 endif 1230 1231 1232 cc!!! ADD key callhedin 1233 1234 IF(callnlte.or.callthermos) THEN 1122 1235 call compo_hedin83_mod(pplay,rmu0, 1123 1236 & co2vmr_gcm,covmr_gcm,ovmr_gcm,n2vmr_gcm,nvmr_gcm) 1237 1238 IF(ok_chem) then 1239 1240 CC !! GG : Using only mayor species tracers abundances to compute NLTE heating/cooling 1241 1242 CC Conversion [mmr] ---> [vmr] 1243 1244 co2vmr_gcm(:,:) = tr_seri(1:nlon,1:nlev,i_co2)* 1245 & mmean(1:nlon,1:nlev)/M_tr(i_co2) 1246 covmr_gcm(:,:) = tr_seri(1:nlon,1:nlev,i_co)* 1247 & mmean(1:nlon,1:nlev)/M_tr(i_co) 1248 ovmr_gcm(:,:) = tr_seri(1:nlon,1:nlev,i_o)* 1249 & mmean(1:nlon,1:nlev)/M_tr(i_o) 1250 n2vmr_gcm(:,:) = tr_seri(1:nlon,1:nlev,i_n2)* 1251 & mmean(1:nlon,1:nlev)/M_tr(i_n2) 1252 1253 ENDIF 1254 1124 1255 ENDIF 1125 1256 1126 if(callthermos) then 1127 call concentrations2(pplay,t_seri,d_t,co2vmr_gcm, n2vmr_gcm, 1128 & covmr_gcm, ovmr_gcm,nvmr_gcm,pdtphys) 1129 endif 1130 1131 1132 c NLTE cooling from CO2 emission 1133 c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1257 c 1258 c NLTE cooling from CO2 emission 1259 c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1134 1260 1135 1261 IF(callnlte) THEN 1136 1262 if(nltemodel.eq.0.or.nltemodel.eq.1) then 1137 CALL nltecool(klon, klev, pplay*9.869e-6, t_seri, 1138 $ co2vmr_gcm,n2vmr_gcm, covmr_gcm, ovmr_gcm, 1139 $ d_t_nlte) 1263 CALL nltecool(klon, klev, nqmax, pplay*9.869e-6, t_seri, 1264 $ tr_seri, d_t_nlte) 1140 1265 else if(nltemodel.eq.2) then 1141 1266 CALL nlte_tcool(klon,klev,pplay*9.869e-6, 1142 1267 $ t_seri,zzlay,co2vmr_gcm, n2vmr_gcm, covmr_gcm, 1143 1268 $ ovmr_gcm,d_t_nlte,ierr_nlte,varerr ) … … 1162 1287 $ CALL nlthermeq(klon, klev, paprs, pplay) 1163 1288 1164 1165 c LTE radiative transfert / solar / IR matrix 1166 c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1167 1289 c 1290 c LTE radiative transfert / solar / IR matrix 1291 c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1168 1292 CALL radlwsw 1169 1293 e (dist, rmu0, fract, zzlev, … … 1171 1295 1172 1296 1173 c 1174 c 1297 c CO2 near infrared absorption 1298 c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1175 1299 1176 1300 d_t_nirco2(:,:)=0. 1177 1301 if (callnirco2) then 1178 call nirco2abs (klon, klev, pplay, dist, nqmax, qx, 1179 . rmu0, fract, d_t_nirco2, 1180 . co2vmr_gcm, ovmr_gcm) 1302 call nirco2abs (klon, klev, pplay, dist, nqmax, tr_seri, 1303 . rmu0, fract, d_t_nirco2) 1181 1304 endif 1182 1305 … … 1209 1332 IF (callthermos) THEN 1210 1333 1211 c call thermosphere(zplev,zplay,dist_sol, 1212 c $ mu0,ptimestep,ptime,zday,tsurf,zzlev,zzlay, 1213 c & pt,pq,pu,pv,pdt,pdq, 1214 c $ zdteuv,zdtconduc,zdumolvis,zdvmolvis,zdqmoldiff) 1215 1216 call euvheat(klon, klev, t_seri,paprs,pplay,zzlay, 1217 $ rmu0,pdtphys,gmtime,rjourvrai, 1218 C $ pq,pdq,zdteuv) 1219 $ co2vmr_gcm, n2vmr_gcm, covmr_gcm, 1220 $ ovmr_gcm,nvmr_gcm,d_t_euv ) 1221 1334 c call euvheat(klon, klev,t_seri,paprs,pplay,zzlay, 1335 c $ rmu0,pdtphys,gmtime,rjourvrai, co2vmr_gcm, n2vmr_gcm, 1336 c $ covmr_gcm, ovmr_gcm,d_t_euv ) 1337 call euvheat(klon, klev, nqmax, t_seri,paprs,pplay,zzlay, 1338 $ rmu0,pdtphys,gmtime,rjourvrai, 1339 $ tr_seri, d_tr, d_t_euv ) 1340 1222 1341 DO k=1,klev 1223 1342 DO ig=1,klon … … 1262 1381 call molvis(klon, klev, pdtphys, 1263 1382 $ pplay,paprs,t_seri, 1264 $ v,tsurf,zzlev,zzlay,d_ u_molvis)1383 $ v,tsurf,zzlev,zzlay,d_v_molvis) 1265 1384 1266 1385 DO k=1,klev … … 1271 1390 ENDDO 1272 1391 ENDDO 1273 1274 ENDIF ! callthermos 1392 ENDIF 1393 1394 1395 ! -- MOLECULAR DIFFUSION --- 1396 1397 d_q_moldif(:,:,:)=0 1398 1399 IF (callthermos .and. ok_chem) THEN 1400 1401 call moldiff_red(klon, klev, nqmax, 1402 & pplay,paprs,t_seri, tr_seri, pdtphys, 1403 & zzlay,d_t_euv,d_t_conduc,d_q_moldif) 1404 1405 1406 ! --- update tendencies tracers --- 1407 1408 DO iq = 1, nqmax 1409 DO k=1,klev 1410 DO ig=1,klon 1411 tr_seri(ig,k,iq)= tr_seri(ig,k,iq)+ 1412 & d_q_moldif(ig,k,iq)*dtime ! [Kg/kg]? 1413 ENDDO 1414 ENDDO 1415 ENDDO 1416 1417 1418 ENDIF ! callthermos & ok_chem 1275 1419 1276 1420 c==================================================================== -
trunk/LMDZ.VENUS/libf/phyvenus/phytrac_chimie.F
r1305 r1442 15 15 I temp, 16 16 I pplev, 17 O trac, 18 O NBRTOT_droplet, 19 O W_H2SO4, 20 O rho) 21 17 O trac) 22 18 c====================================================================== 23 19 c Auteur(s) FH … … 28 24 cAA 1/ le call phytrac se fait avec nqmax 29 25 c====================================================================== 26 c USE ioipsl 27 c USE infotrac 28 c USE control_mod 29 c USE dimphy 30 c USE comgeomphy 30 31 USE chemparam_mod 32 use conc, only: mmean 31 33 IMPLICIT none 32 34 35 c#include "dimensions.h" 33 36 #include "clesphys.h" 37 c#include "temps.h" 38 c#include "paramet.h" 39 c#include "comcstfi.h" !me permet de recuperer mugaz et d'autres constantes comme rad,pi etc 34 40 #include "YOMCST.h" 35 41 c====================================================================== … … 53 59 INTEGER n_lev ! nombre de couches verticales 54 60 INTEGER nqmax ! nombre de traceurs auxquels on applique la physique 55 c INTEGER nbapp_cloud, i_app_cloud 61 56 62 real pdtphys ! pas d'integration pour la physique (seconde) 57 63 real lat(n_lon), lat_local(n_lon) 58 64 real lon(n_lon), lon_local(n_lon) 59 65 real temp(n_lon,n_lev) ! temp 60 real trac(n_lon,n_lev,nqmax) ! traceur 66 real trac(n_lon,n_lev,nqmax) ! traceur 67 real trac_sav(n_lon,n_lev,nqmax) 68 real trac_sum(n_lon,n_lev) 61 69 real pplev(n_lon,n_lev) ! pression pour le mileu de chaque couche (en Pa) 62 70 real lon_sun 71 63 72 logical debutphy ! le flag de l'initialisation de la physique 64 c character*7 modname 65 66 C 67 C---------------------------------------------------------------------------- 68 C Model cloud: 69 C Aerosol and PSC variables: 70 real NBRTOT_droplet(n_lon,n_lev) 71 real W_H2SO4(n_lon,n_lev) 72 real W_H2O(n_lon,n_lev) 73 real rho(n_lon,n_lev) 74 C---------------------------------------------------------------------------- 75 C---------------------------------------------------------------------------- 76 C Time variables: 77 REAL, save :: dT_cloud 78 C---------------------------------------------------------------------------- 79 C---------------------------------------------------------------------------- 73 80 74 C Auxilary variables: 81 75 82 REAL mrtwv,mrtsa,mrwv,mrsa,83 + ppwv, psatwv,84 + ps_sa,satps_sa76 REAL, DIMENSION(n_lon,n_lev) :: mrtwv,mrtsa, 77 + mrwv,mrsa 78 85 79 C ps_sa: satur pressure pure SA 86 80 C satps_sa: satur pres over mixture in dyne/cm2=Pa/10 … … 101 95 102 96 if (debutphy) then 103 104 PRINT*,'PRECISION REAL'105 PRINT*,precision(NBRTOT_droplet(1,1)), range(NBRTOT_droplet(1,1))106 97 107 98 if (n_lon .EQ. 1) then … … 119 110 c endif 120 111 121 122 112 IF (reinit_trac) THEN 113 PRINT*,'REINIT MIXING RATIO TRACEURS' 123 114 124 115 c ============================================================= 125 116 c Passage de Rm à Rv 126 117 c ============================================================= 127 c Necessaire si on reprend les start.nc qui sont en MMR 128 DO iq=1,nqmax 129 trac(:,:,iq)=trac(:,:,iq)*RMD/M_tr(iq) 130 END DO 118 c Necessaire si on reprend les start.nc qui sont en MMR 119 120 DO iq=1,nqmax 121 trac(:,:,iq)=trac(:,:,iq)*mmean(:,:)/M_tr(iq) 122 END DO 131 123 c ============================================================= 132 124 133 134 125 c============================================================= 135 126 c Initialisation des profils traceurs en Rv 136 127 c============================================================= 137 trac(:,:,:)=1.0d-30 138 139 trac(:,:,i_co2)=0.965d0 * RMD / M_tr(i_co2) 140 141 trac(:,:,i_co)=25.0d-6 142 143 144 trac(:,:,i_h2so4)=1.0d-21 145 trac(:,:,i_h2o)=1.0d-21 146 147 c !!! SANS NUAGE !!! 148 c trac(:,1:29,i_ocs)=1.0d-6 149 c trac(:,29:40,i_ocs)=1.0e-9 150 c trac(:,:,i_so2)=1.d-6 151 c trac(:,:,i_h2o)=1.0d-6 128 c initialisation sert a mettre les valeurs voulues par utilisateur pour 129 c chaque traceur 130 c exemple: trac(ilon,ilev,q)=xx 131 132 c trac_sav sert a sauver les valeurs initiales du start.nc 133 trac_sav=trac 134 135 c On initialise les traceurs a zero obligatoire pour la chimie 136 trac(:,:,:)=1.0E-30 152 137 153 138 c !!! AVEC NUAGE !!! 154 trac(:,1:20,i_ocs)=3.d-6 155 156 DO i=21,26 157 trac(:,i,i_ocs)=trac(:,i-1,i_ocs)-0.3d-6 158 END DO 159 160 c DO i=21,30 161 c trac(:,i,i_ocs)=trac(:,i-1,i_ocs)-0.3d-6 162 c END DO 163 164 trac(:,1:26,i_hcl)=0.2d-6 165 166 c trac(:,:,i_hcl)=0.2d-6 167 168 c Initialisation SO2 Bertaux et De Bergh 2007 JGR 169 c trac(:,1:26,i_so2)=20.d-6 170 c DO i=2,20 171 c trac(:,i,i_so2)=trac(:,i-1,i_so2)+(100./19.)*0.25d-6 172 c END DO 173 c DO i=21,22 174 c trac(:,i,i_so2)=trac(:,i-1,i_so2)-(100./9.)*0.25d-6 175 c END DO 176 177 c DO i=21,29 178 c trac(:,i,i_so2)=trac(:,i-1,i_so2)-(100./9.)*1d-6 179 c END DO 180 181 c trac(:,1:30,i_so2)= 100.0d-6 182 c trac(:,30,i_so2)=20.0d-6 183 c trac(:,31,i_so2)=10.0d-6 184 c trac(:,32,i_so2)=1.0d-6 185 c trac(:,33,i_so2)=0.1d-6 186 c trac(:,34:42,i_so2)=0.02d-6 187 c trac(:,43:46,i_so2)=0.07d-6 188 c trac(:,47:50,i_so2)=0.05d-6 189 190 c trac(:,1:28,i_h2o)=30.0d-6 191 c trac(:,29:50,i_h2o)=5.0d-6 192 trac(:,15:50,i_h2o)=10.0d-6 193 c trac(:,15:35,i_h2so4)=17.0d-6 194 c DO i=23,35 195 c trac(:,i,i_h2o)=(3.d-6-30.0d-6)/12.0*(-23.0+i)+trac(:,22,i_h2o) 196 c END DO 197 c trac(:,36:50,i_h2o)=3.0d-6 198 199 trac(:,15:50,i_h2so4)=20.0d-6 200 c trac(:,29:50,i_h2so4)=1.0d-9 201 c trac(:,1:10,i_h2)=1.0d-10 202 c trac(:,11:20,i_h2)=1.0d-9 203 c trac(:,21:35,i_h2)=1.0d-8 204 c trac(:,36:50,i_h2)=1.0d-7 139 trac(:,1:22,i_ocs)=3.E-6 140 trac(:,:,i_hcl)=0.4E-6 141 trac(:,1:22,i_so2)=10.E-6 142 trac(:,1:22,i_h2o)=30.0E-6 143 144 c remettre tous les traceurs du start => trac(:,:,:)=trac_sav(:,:,:) 145 146 c N2 n est pas encore une espece chimique du modele chimique 147 c traceur passif pour la chimie-transport 148 trac(:,:,i_n2)=0.35d-1 205 149 150 !!!! GG: Initialization CO2 = 1 - qtot 151 !! It assures that vmr_tot = 1 152 c On a donc le CO2 qui est le restant d atmosphere Venus 153 trac_sum(:,:)=0.0 154 DO iq=2,nqmax 155 trac_sum(:,:)= trac_sum(:,:) + trac(:,:,iq) 156 END DO 157 158 trac(:,:,i_co2)= 1-trac_sum(:,:) 159 206 160 c============================================================= 207 161 … … 210 164 c ============================================================= 211 165 DO iq=1,nqmax 212 trac(:,:,iq)=trac(:,:,iq)*M_tr(iq)/RMD166 trac(:,:,iq)=trac(:,:,iq)*M_tr(iq)/mmean(:,:) 213 167 END DO 214 168 c ============================================================= 215 216 c Ecriture fichier initialisation 217 c PRINT*,'Ecriture Initial_State.csv' 218 c OPEN(88,file='Initial_State.csv', 219 c & form='formatted') 220 221 c DO ilon=1,n_lon 222 c DO ilev=1,n_lev 223 c WRITE(88,"(36(e15.8,','))") R_MEDIAN(ilon,ilev), 224 c & STDDEV(ilon,ilev),trac(ilon,ilev,1:nqmax) 225 c ENDDO 226 c ENDDO 227 c PRINT*,'FIN Ecriture Initial_State.csv' 228 229 ENDIF !FIN REINIT TRAC 169 170 ENDIF !FIN REINIT TRAC 171 230 172 231 173 c------------- 232 174 c fin debutphy 233 175 c------------- 176 234 177 ENDIF ! fin debutphy 235 178 … … 237 180 c Passage de Rm à Rv 238 181 c ============================================================= 239 DO iq=1,nqmax 240 trac(:,:,iq)=trac(:,:,iq)*RMD/M_tr(iq) 241 END DO 242 c ============================================================= 243 244 245 c============================================================= 246 c Boucle sur les lon, lat (n_lon) 247 c============================================================= 248 c PRINT*, 'gmtime', gmtime*RDAY 249 c PRINT*, 'RDAY', RDAY 250 251 lon_sun = (0.5 - gmtime) * 2.0 * RPI 252 lon_local = lon * RPI/180.0d0 253 lat_local = lat * RPI/180.0d0 254 255 DO ilon=1, n_lon 256 257 c calcul sza_local pour obtenir des sza_local > 90, utile pour la chimie 258 sza_local = acos(cos(lat_local(ilon))*cos(lon_local(ilon))* 259 & cos(lon_sun) + cos(lat_local(ilon))*sin(lon_local(ilon)) 260 & *sin(lon_sun))* 180.0d0/RPI 261 262 c PRINT*,'sza_local :', sza_local 263 264 IF (ok_cloud) THEN 265 c PRINT*,'DEBUT CLOUD' 266 267 dT_cloud=pdtphys 268 269 270 c nbapp_cloud=NINT(pdtphys/dT_cloud) 271 c PRINT*,'pdtphys',pdtphys 272 c PRINT*,'nbapp_cloud',nbapp_cloud 182 DO iq=1,nqmax 183 trac(:,:,iq)=MAX(trac(:,:,iq)*mmean(:,:)/M_tr(iq),1.E-30) 184 END DO 185 c ============================================================= 186 187 273 188 c ============================================================= 274 189 c Appel Microphysique (sans nucleation) … … 276 191 c ============================================================= 277 192 278 c FIXE un profil de temperature def dans fichier temp 279 if (n_lon .EQ. 1) then 280 OPEN(13,file='temp',status='old',form='formatted') 281 DO ilev=1,n_lev 282 READ (13,*) temp(n_lon,ilev) 283 ENDDO 284 CLOSE(13) 285 endif 286 287 DO ilev=1, n_lev 288 c PRINT*,'DEBUT INIT CALL CLOUD' 289 c ppwv et pplev en Pa 290 291 c PRINT*,'@@@@ IN CLOUD @@@@' 292 193 IF (ok_cloud) THEN 194 195 c PRINT*,'DEBUT CLOUD' 293 196 c On remet tout le RM liq dans la partie gaz 294 197 c !!! On reforme un nuage à chaque fois !!! 295 296 mrtwv=trac(ilon,ilev,i_h2o) + trac(ilon,ilev,i_h2oliq) 297 mrtsa=trac(ilon,ilev,i_h2so4) + trac(ilon,ilev,i_h2so4liq) 298 mrwv=mrtwv 299 mrsa=mrtsa 300 301 302 c !!! Remise a zero !!! 303 W_H2SO4(ilon,ilev)=0.0d0 304 W_H2O(ilon,ilev)=0.d0 305 rho(ilon,ilev)=0.0d0 306 NBRTOT_droplet(ilon,ilev)=0.d0 307 satps_sa=0.d0 308 ps_sa=0.d0 309 310 c pression partielle H2O 311 ppwv=pplev(ilon,ilev) * mrwv 312 313 c Pression saturante de vapeur d'eau, tirée du code d'Anni 314 psatwv=EXP(77.344913 - 7235.4247/temp(ilon,ilev) 315 & - 8.2*DLOG(temp(ilon,ilev)) + 0.0057113*temp(ilon,ilev)) 316 317 c PRINT*,'DEBUT CALL CLOUD' 318 319 c Ne pas passer par la routine des nuages si on a des valeurs proches de 0 ? 320 c Empeche de foirer en parallèle ? 321 322 323 CALL new_cloud_venus(dT_cloud, 324 e NBRTOT_droplet(ilon,ilev), 325 e R_MEDIAN(ilon,ilev),STDDEV(ilon,ilev), 326 e temp(ilon,ilev),pplev(ilon,ilev), 327 e ppwv, 328 e mrwv,mrsa, 329 e ilev, 198 199 DO ilev=1, n_lev 200 DO ilon=1, n_lon 201 mrtwv(ilon,ilev)=trac(ilon,ilev,i_h2o) + 202 & trac(ilon,ilev,i_h2oliq) 203 mrtsa(ilon,ilev)=trac(ilon,ilev,i_h2so4) + 204 & trac(ilon,ilev,i_h2so4liq) 205 mrwv(ilon,ilev)=mrtwv(ilon,ilev) 206 mrsa(ilon,ilev)=mrtsa(ilon,ilev) 207 ENDDO 208 ENDDO 209 210 CALL new_cloud_venus(n_lev, n_lon, 211 e temp,pplev, 330 212 e mrtwv,mrtsa, 331 e W_H2SO4(ilon,ilev), 332 e ps_sa,satps_sa, 333 e rho(ilon,ilev)) 334 335 c END DO 336 213 e mrwv,mrsa) 214 337 215 c ========================================= 338 216 c Actualisation des mixing ratio liq et gaz … … 344 222 c PRINT*,'DEBUT ACTUALISATION OUTPUT CLOUD' 345 223 c si tout se passe bien, mrtwv et mrtsa ne changent pas 346 347 trac(ilon,ilev,i_h2o) = mrwv 348 trac(ilon,ilev,i_h2oliq) = mrtwv - trac(ilon,ilev,i_h2o) 224 DO ilev=1, n_lev 225 DO ilon=1, n_lon 226 trac(ilon,ilev,i_h2o) = mrwv(ilon,ilev) 227 trac(ilon,ilev,i_h2oliq) = mrtwv(ilon,ilev) - 228 & trac(ilon,ilev,i_h2o) 349 229 350 trac(ilon,ilev,i_h2so4) = mrsa 351 trac(ilon,ilev,i_h2so4liq) = mrtsa - trac(ilon,ilev,i_h2so4) 352 353 c ENDIF 354 355 356 IF (n_lon .EQ. 1) THEN 357 WRITE(66,"(i4,','11(e15.8,','))") ilev,temp(ilon,ilev), 358 & pplev(ilon,ilev),ps_sa,satps_sa,NBRTOT_droplet(ilon,ilev), 359 & W_H2SO4(ilon,ilev),trac(ilon,ilev,i_h2oliq), 360 & trac(ilon,ilev,i_h2so4liq),mrwv,mrsa,trac(ilon,ilev,i_so2) 361 ENDIF 362 363 END DO 230 trac(ilon,ilev,i_h2so4) = mrsa(ilon,ilev) 231 trac(ilon,ilev,i_h2so4liq) = mrtsa(ilon,ilev) - 232 & trac(ilon,ilev,i_h2so4) 233 ENDDO 234 ENDDO 364 235 365 236 c ============================================================= 366 237 c PRINT*,'FIN CLOUD' 367 238 ENDIF 368 239 240 c============================================================= 241 c CHIMIE: Boucle sur les lon, lat (n_lon) 242 c============================================================= 243 244 c AS: 245 c Ici, la longitude au midi local se deplace vers l'Ouest 246 c c'est le sens terrestre 247 c pour Vénus on prend juste l'opposé de la longitude et on a la rotation 248 c de Vénus et donc le midi local qui se déplace vers l'Est 249 250 lon_sun = (0.5 - gmtime) * 2.0 * RPI 251 lon_local = lon * RPI/180.0E+0 252 lat_local = lat * RPI/180.0E+0 253 254 DO ilon=1, n_lon 255 256 c calcul sza_local pour obtenir des sza_local > 90, utile pour la chimie 257 sza_local = acos(cos(lat_local(ilon))*cos(lon_local(ilon))* 258 & cos(lon_sun) + cos(lat_local(ilon))*sin(lon_local(ilon)) 259 & *sin(lon_sun))* 180.0E+0/RPI 260 261 c PRINT*,'sza_local :', sza_local 262 369 263 IF (ok_chem) THEN 370 c PRINT*,"vmr SO2 ht atmo: ",trac(1,50,i_so2)371 264 c PRINT*,'DEBUT CHEMISTRY' 372 265 c ============================================================= … … 382 275 c ============================================================= 383 276 c PRINT*,'FIN CHEMISTRY' 384 c PRINT*,"vmr SO2 ht atmo: ",trac(1,50,i_so2) 385 277 386 278 END IF 387 279 … … 391 283 c ============================================================= 392 284 DO iq=1,nqmax 393 trac(:,:,iq)=trac(:,:,iq)*M_tr(iq)/RMD 285 c trac(:,:,iq)=trac(:,:,iq)*M_tr(iq)/RMD 286 trac(:,:,iq)=trac(:,:,iq)*M_tr(iq)/mmean(:,:) 287 394 288 END DO 395 289 c ============================================================= 396 397 c PRINT*,'FIN PHYTRAC' 290 C PRINT*,'FIN PHYTRAC' 398 291 RETURN 399 292 END -
trunk/LMDZ.VENUS/libf/phyvenus/printflag.F
r815 r1442 123 123 124 124 12 FORMAT(2x,'***** Nb d appels /jour des routines de rayonn. = ' , 125 , i 4,6x,' *****')125 , i5,6x,' *****') 126 126 127 127 13 FORMAT(2x,'$$$$$$$$ Attention !! cycle_diurne different sur', -
trunk/LMDZ.VENUS/libf/phyvenus/radlwsw.F
r1310 r1442 179 179 180 180 ips0=0 181 if (nbpsve(lat).gt.1) then 181 182 do ips=1,nbpsve(lat)-1 182 183 if ( (psurfve(ips,lat).ge.paprs(j,1)) … … 189 190 endif 190 191 enddo 192 else ! Only one ps, no interpolation 193 ips0=1 194 endif 191 195 isza0=0 192 196 if (nbszave(lat).gt.1) then … … 205 209 endif 206 210 211 c -------- Probleme aux bords 212 if ((ips0.eq.0).and.(psurfve(1,lat).gt.paprs(j,1))) then 213 ips0 = 1 214 print*,'Extrapolation! ig=',j,' ips0=',ips0 215 factp = (paprs(j,1) -psurfve(ips0,lat)) 216 . /(psurfve(ips0+1,lat)-psurfve(ips0,lat)) 217 endif 218 if ((ips0.eq.0).and.(psurfve(nbpsve(lat),lat).le.paprs(j,1))) 219 . then 220 ips0 = nbpsve(lat)-1 221 print*,'Extrapolation! ig=',j,' ips0=',ips0 222 factp = (paprs(j,1) -psurfve(ips0,lat)) 223 . /(psurfve(ips0+1,lat)-psurfve(ips0,lat)) 224 endif 225 c --------- 226 207 227 if ((ips0.eq.0).or.(isza0.eq.0)) then 208 228 write(*,*) 'Finding the right matrix in radlwsw' … … 254 274 c--------- 255 275 znivs=zzlev(j,:) 276 c CALL SW_venus_ve_1Dglobave(zrmu0, zfract, ! pour moy globale 256 277 c CALL SW_venus_ve(zrmu0, zfract, 257 278 c S PPB,temp,znivs, … … 259 280 c S ztopsw,zsolsw,ZFSNET) 260 281 282 c CALL SW_venus_cl_1Dglobave(zrmu0, zfract, ! pour moy globale 283 c CALL SW_venus_cl(zrmu0, zfract, 284 c CALL SW_venus_dc_1Dglobave(zrmu0, zfract, ! pour moy globale 261 285 CALL SW_venus_dc(zrmu0, zfract, 262 286 S PPB,temp, -
trunk/LMDZ.VENUS/libf/phyvenus/sw_venus_dc.F
r1310 r1442 68 68 real zldn ! downward IR flux (W/m**2) ? 69 69 real zlup ! upward IR flux (W/m**2) ? 70 real zsolnet(nldc+1) ! for testing mean net solar flux in DC71 70 character*22 nullchar 72 71 real sza0,factsza,factflux 73 72 logical firstcall 74 73 data firstcall/.true./ 75 REAL,save,allocatable :: zsolVE(:) ! net solar flux at ppb levels, fichiers VE76 74 save solza,zsnet,presdc,tempdc,altdc 77 75 save firstcall … … 82 80 83 81 if (firstcall) then 84 allocate(zsolVE(klevp1))85 82 86 83 open(11,file='dataDCrisp.dat') … … 111 108 close(11) 112 109 113 c ----------- TEST ------------114 c Fichiers de Vincent115 c -----------------------------116 c open(12,file='flux_vis_dcGCM.txt')117 c read(12,*) nullchar118 c119 c do j=1,klev+1120 c read(12,*) zlup,zldn,zsolVE(j)121 c enddo122 c123 c close(12)124 c -----------------------------125 c -------- FIN TEST ----------126 127 110 firstcall=.false. 128 111 endif 129 130 c ----------- TEST ------------131 c Moyenne planetaire132 c -----------------------------133 c do j=1,nldc134 c ---135 c zsolnet(j) = zsnet(j,1)*0.5*136 c . sin(solza(1)*RPI/180.)*solza(2)*RPI/180./2.137 c do nsza=2,nszadc-1138 c zsolnet(j) = zsolnet(j)+zsnet(j,nsza)*0.5*139 c . sin(solza(nsza)*RPI/180.)*140 c . (solza(nsza+1)-solza(nsza-1))*RPI/180./2.141 c enddo142 c zsolnet(j) = zsolnet(j)+zsdn(j,nszadc)*0.5*143 c . sin(solza(nszadc)*RPI/180.)*144 c . (90.-solza(nszadc-1))*RPI/180./2.145 c ---146 c zsolnet(j) = 0.0147 c do nsza=1,nszadc-1148 c zsolnet(j) = zsolnet(j)+(zsnet(j,nsza )149 c . +zsnet(j,nsza+1))*0.5*150 c . (cos(solza(nsza )*RPI/180.)-151 c . cos(solza(nsza+1)*RPI/180.) )152 c enddo153 c zsolnet(j) = zsolnet(j)+zsnet(j,nszadc)*0.25*154 c . cos(solza(nszadc)*RPI/180.)155 c ---156 c print*,j,altdc(j),zsolnet(j)157 c enddo158 c stop159 c -----------------------------160 c -------- FIN TEST ----------161 112 162 113 c -------------------------------------- … … 212 163 enddo 213 164 214 c ----------- TEST ------------215 c Fichiers de Vincent216 c -----------------------------217 c do j=1,klev+1218 c ZFSNET(j)=zsolVE(j)219 c enddo220 c -----------------------------221 c -------- FIN TEST ----------222 223 165 PTOPSW = ZFSNET(klev+1) 224 166 PSOLSW = ZFSNET(1) -
trunk/LMDZ.VENUS/libf/phyvenus/write_histins.h
r1310 r1442 16 16 call histwrite_phy(nid_ins,.false.,"psol",itau_w,paprs(:,1)) 17 17 c call histwrite_phy(nid_ins,.false.,"ue",itau_w,ue) 18 c VENUS: regardee a l' envers!!!!!!!!!!!!!!!18 c VENUS: regardee a l' envers!!!!!!!!!!!!!!! 19 19 c call histwrite_phy(nid_ins,.false.,"ve",itau_w,-1.*ve) 20 20 c call histwrite_phy(nid_ins,.false.,"cdragh",itau_w,cdragh) … … 32 32 call histwrite_phy(nid_ins,.false.,"geop",itau_w,zphi) 33 33 call histwrite_phy(nid_ins,.false.,"vitu",itau_w,u_seri) 34 c VENUS: regardee a l' envers!!!!!!!!!!!!!!!34 c VENUS: regardee a l' envers !!!!!!!!!!!!!!! 35 35 call histwrite_phy(nid_ins,.false.,"vitv",itau_w,-1.*v_seri) 36 36 call histwrite_phy(nid_ins,.false.,"vitw",itau_w,omega) … … 42 42 c call histwrite_phy(nid_ins,.false.,"Kz",itau_w,ycoefh) 43 43 44 c plusieurs traceurs 45 IF ( iflag_trac.eq.1) THEN44 c plusieurs traceurs !!!outputs in [vmr] 45 IF (ok_chem) THEN 46 46 DO iq=1,nqmax 47 call histwrite_phy(nid_ins,.false.,tname(iq),itau_w,qx(:,:,iq)) 47 call histwrite_phy(nid_ins,.false.,tname(iq),itau_w,qx(:,:,iq)* 48 & mmean(:,:)/M_tr(iq)) 48 49 ENDDO 49 50 ENDIF 51 52 call histwrite_phy(nid_ins,.false.,"tops",itau_w,topsw) 53 54 IF (ok_cloud) THEN 55 56 IF (nb_mode.GE.1) THEN 57 call histwrite_phy(nid_ins,.false.,"NBRTOTm1",itau_w, 58 & NBRTOT(:,:,1)) 59 60 c call histwrite_phy(nid_ins,.false.,"R_MEDIANm1",itau_w, 61 c & R_MEDIAN(:,:,1)) 62 63 c call histwrite_phy(nid_ins,.false.,"STDDEVm1",itau_w, 64 c & STDDEV(:,:,1)) 65 66 IF (nb_mode.GE.2) THEN 67 call histwrite_phy(nid_ins,.false.,"NBRTOTm2",itau_w, 68 & NBRTOT(:,:,2)) 69 70 c call histwrite_phy(nid_ins,.false.,"R_MEDIANm2",itau_w, 71 c & R_MEDIAN(:,:,2)) 72 73 c call histwrite_phy(nid_ins,.false.,"STDDEVm2",itau_w, 74 c & STDDEV(:,:,2)) 75 76 IF (nb_mode.GE.3) THEN 77 call histwrite_phy(nid_ins,.false.,"NBRTOTm3",itau_w, 78 & NBRTOT(:,:,3)) 79 80 c call histwrite_phy(nid_ins,.false.,"R_MEDIANm3",itau_w, 81 c & R_MEDIAN(:,:,3)) 82 83 c call histwrite_phy(nid_ins,.false.,"STDDEVm3",itau_w, 84 c & STDDEV(:,:,3)) 50 85 51 call histwrite_phy(nid_ins,.false.,"tops",itau_w,topsw) 52 53 if (ok_cloud) THEN 54 call histwrite_phy(nid_ins,.false.,"NBRTOT",itau_w,NBRTOT) 55 call histwrite_phy(nid_ins,.false.,"WH2SO4",itau_w,WH2SO4) 56 call histwrite_phy(nid_ins,.false.,"R_MEDIAN",itau_w,R_MEDIAN) 57 call histwrite_phy(nid_ins,.false.,"STDDEV",itau_w,STDDEV) 58 call histwrite_phy(nid_ins,.false.,"rho_droplet", 59 & itau_w,rho_droplet) 60 endif 61 62 if (ok_sedim) THEN 63 call histwrite_phy(nid_ins,.false.,"d_tr_sed_H2SO4", 64 & itau_w,d_tr_sed(:,:,1)) 65 call histwrite_phy(nid_ins,.false.,"d_tr_sed_H2O", 66 & itau_w,d_tr_sed(:,:,2)) 67 call histwrite_phy(nid_ins,.false.,"F_sedim",itau_w,Fsedim) 68 endif 69 86 ENDIF 87 ENDIF 88 ENDIF 89 90 call histwrite_phy(nid_ins,.false.,"WH2SO4",itau_w,WH2SO4) 91 92 call histwrite_phy(nid_ins,.false.,"rho_droplet",itau_w, 93 & rho_droplet) 94 ENDIF 95 IF (ok_sedim) THEN 96 97 call histwrite_phy(nid_ins,.false.,"d_tr_sed_H2SO4",itau_w, 98 & d_tr_sed(:,:,1)) 99 call histwrite_phy(nid_ins,.false.,"d_tr_sed_H2O",itau_w, 100 & d_tr_sed(:,:,2)) 101 102 call histwrite_phy(nid_ins,.false.,"F_sedim",itau_w,Fsedim) 103 ENDIF 70 104 ENDIF !lev_histins.GE.2 71 105 … … 103 137 c en K/s 104 138 call histwrite_phy(nid_ins,.false.,"dtajs",itau_w,d_t_ajs) 105 c en K/s106 call histwrite_phy(nid_ins,.false.,"dtswr",itau_w, dtsw)107 c enK/s108 call histwrite_phy(nid_ins,.false.,"dtlwr",itau_w, dtlw)139 c K/day ==> K/s 140 call histwrite_phy(nid_ins,.false.,"dtswr",itau_w,heat/RDAY) 141 c K/day ==> K/s 142 call histwrite_phy(nid_ins,.false.,"dtlwr",itau_w,-1.*cool/RDAY) 109 143 c en K/s 110 144 c call histwrite_phy(nid_ins,.false.,"dtec",itau_w,d_t_ec) … … 116 150 call histwrite_phy(nid_ins,.false.,"dugwno",itau_w,d_u_hin) 117 151 c en (m/s)/s 118 c VENUS: regardee a l 'envers!!!!!!!!!!!!!!!152 c VENUS: regardee a l envers!!!!!!!!!!!!!!! 119 153 c call histwrite_phy(nid_ins,.false.,"dvvdf",itau_w,-1.*d_v_vdf) 120 154 -
trunk/UTIL/compile
r1366 r1442 4 4 # > compile zrecast 5 5 6 # pgf sur les machines du LMD :7 #----------------------------- 6 # pgf sur les machines du LMD (ferme): 7 #------------------------------------- 8 8 #pgf95 -Bstatic $1.F90 \ 9 9 #-I/distrib/local/netcdf/pgi_7.1-6_64/include \ 10 10 #-L/distrib/local/netcdf/pgi_7.1-6_64/lib -lnetcdf -o $1.e 11 11 12 # gfortran au LMD 13 #---------------- 14 gfortran $1.F90 \ 15 -I/d2/emlmd/netcdf64-4.0.1_gfortran/include \ 16 -L/d2/emlmd/netcdf64-4.0.1_gfortran/lib -lnetcdf -o $1.e 17 12 18 # ifort 13 19 #------ 14 ifort $1.F90 \15 -I$NETCDF/include \16 -L$NETCDF/lib -lnetcdf -o $1.e20 #ifort $1.F90 \ 21 #-I$NETCDF/include \ 22 #-L$NETCDF/lib -lnetcdf -o $1.e 17 23 18 24 #----------------------------------------------------------------- -
trunk/UTIL/zrecast.F90
r1366 r1442 80 80 81 81 character (len=64) :: text ! to store some text 82 character (len=64) :: timeunit ! to store the units for time axis 82 83 character (len=64) :: tmpvarname ! temporarily store a variable name 83 84 integer tmpvarid ! temporarily store a variable ID … … 459 460 endif 460 461 endif 462 timeunit=" " 463 ierr=NF_GET_ATT_TEXT(infid,tmpvarid,'units',timeunit) 461 464 462 465 ! altlength … … 1400 1403 stop "Error: Problem writing long_name for Time" 1401 1404 endif 1402 text='days since 0000-01-1 00:00:00' 1403 ierr=NF_PUT_ATT_TEXT(outfid,time_varid,'units',len_trim(text),text) 1405 ierr=NF_PUT_ATT_TEXT(outfid,time_varid,'units',len_trim(timeunit),timeunit) 1404 1406 if (ierr.ne.NF_NOERR) then 1405 1407 stop "Error: Problem writing units for Time"
Note: See TracChangeset
for help on using the changeset viewer.
